I den här artikeln kommer vi att skapa en listbox i användarform och ladda den med värden efter att du har tagit bort dubblettvärden.
Rådata som vi kommer att infoga i listfältet består av namn. Denna rådata innehåller dubblitet i definierade namn.
I det här exemplet har vi skapat en användarform som består av List Box. Denna listruta visar unika namn från provdata. För att aktivera användarformen, klicka på skicka -knappen.
Denna användarform kommer att returnera det namn som användaren valt som utmatning i en meddelanderuta.
Logisk förklaring
Innan vi lägger till namn i listrutan har vi använt samlingsobjekt för att ta bort dubblettnamn.
Vi har utfört följande steg för att ta bort dubblettposter:-
-
Har lagt till namn från det definierade intervallet i Excel -arket till samlingsobjektet. I samlingsobjekt kan vi inte infoga dubblettvärden. Samlingsobjektet ger alltså fel när du stöter på dubblettvärden. För att hantera fel har vi använt felmeddelandet "Vid felåterupptagning nästa".
-
När du har förberett samlingen lägger du till alla föremål från samlingen till matrisen.
-
Sätt sedan in alla arrayelement i listrutan.
Följ koden nedan
Alternativ Explicit Sub körs () UserForm1.Show End Sub 'Lägg till nedan kod i användarform Alternativ Option Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Looping through all the values present in the list box 'Assign the selected value to variable var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Then var1 = ListBox1.List (i) Exit For End If Next 'Ta bort användarformuläret. Unload Me 'Visar det valda värdet MsgBox "Du har valt följande namn i listfältet:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList As Variant, i As Long' Calling UniqueItemList function 'Assigning the range as input parameter MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 'Clearing the List Box content .Clear' Adding values in the List Box For i = 1 To UBound (MyUniqueList) .AddItem MyUniqueList (i) Next i ' Välj det första objektet .ListIndex = 0 Avsluta med slut Sub Privat funktion UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Deklarerar en dynamisk array Dim uList () As Variant 'Deklarerar denna funktion som flyktig' Medelfunktionen kommer att beräknas igen varje gång beräkning sker i en cellapplikation. Volatil på fel Återuppta nästa 'Lägga till objekt i samlingen' Endast unikt objekt kommer att infogas 'Infogning av dubblettobjekt kommer genom ett fel för varje cl In InputRange If cl.Value "" Then 'Adding values in collection cUnique.Add cl.Value, CStr (cl.Value) End If Next cl' Initializing value return by the function UniqueItemList = "" If cUnique.Count> 0 Then 'Ändra storlek på matrisstorlek ReDim uList (1 till cUnique.Count)' Infoga värden från samling till array För i = 1 Till cUnique.Count uList (i) = cUnique (i) Nästa i UniqueItemList = uList 'Kontrollera värdet på HorizontalList' Om värdet är sant transponerar värdet för UniqueItemList If Not HorizontalList UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End If On Error GoTo 0 End Function
Om du gillade den här bloggen, dela den med dina vänner på Facebook. Du kan också följa oss på Twitter och Facebook.
Vi vill gärna höra från dig, låt oss veta hur vi kan förbättra vårt arbete och göra det bättre för dig. Skriv till oss på e -postwebbplatsen