I denne artikkelen vil vi opprette en listeboks i brukerform og laste den med verdier etter å ha fjernet dupliserte verdier.
Rådata som vi vil sette inn i listeboksen, består av navn. Disse rådataene inneholder to eksemplarer i definerte navn.
I dette eksemplet har vi laget en brukerform som består av List Box. Denne listeboksen vil vise unike navn fra eksempeldataene. For å aktivere brukerskjemaet, klikk på send -knappen.
Denne brukerformen vil returnere navnet som er valgt av brukeren som utdata i en meldingsboks.
Logisk forklaring
Før vi legger til navn i listeboksen, har vi brukt samlingsobjekt for å fjerne dupliserte navn.
Vi har utført følgende trinn for å fjerne dupliserte oppføringer:-
-
Lagt til navn fra det definerte området i Excel -arket i samlingsobjektet. I et samleobjekt kan vi ikke sette inn like verdier. Samlingsobjektet gir derfor feil når du møter dupliserte verdier. For å håndtere feil har vi brukt feilmeldingen "On Error Resume Next".
-
Etter at du har forberedt samlingen, legger du til alle elementene fra samlingen i matrisen.
-
Sett deretter inn alle matriseelementene i listeboksen.
Følg koden nedenfor
Alternativ Eksplisitt sub kjører () UserForm1.Show End Sub 'Legg til under kode i brukerform Alternativ Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Sløyfe gjennom alle verdiene i listeboksen 'Tilordne den valgte verdien til variabel var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Then var1 = ListBox1.List (i) Exit For End If Next 'Unload userform. Unload Me 'Viser den valgte verdien MsgBox "Du har valgt følgende navn i listeboksen:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList As Variant, i As Long' Calling UniqueItemList function 'Assigning range as input parameter MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 'Slette innholdet i listeboksen .Clear' Legge til verdier i listeboksen For i = 1 Til UBound (MyUniqueList) .AddItem MyUniqueList (i) Neste i ' Velge det første elementet .ListIndex = 0 Slutt med slutten Sub Private Function UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Deklarere en dynamisk matrise Dim uList () As Variant 'Deklarere denne funksjonen som flyktig' Betyr funksjonen vil bli beregnet på nytt hver gang beregning skjer i en hvilken som helst celle applikasjon. Volatil på feil gjenoppta neste 'legge til elementer i samlingen' bare unikt element vil bli satt inn 'innsetting av duplikat element vil gjennom en feil for hver 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 'Endre størrelse på matrisestørrelsen ReDim uList (1 til cUnique.Count)' Sette inn verdier fra samling til matrise For i = 1 Til cUnique.Count uList (i) = cUnique (i) Neste i UniqueItemList = uList 'Kontrollere verdien av HorizontalList' Hvis verdien er sann, så transponerer verdien av UniqueItemList If Not HorizontalList Then UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End If On Error GoTo 0 End Function
Hvis du likte denne bloggen, del den med vennene dine på Facebook. Du kan også følge oss på Twitter og Facebook.
Vi vil gjerne høre fra deg, gi oss beskjed om hvordan vi kan forbedre arbeidet vårt og gjøre det bedre for deg. Skriv til oss på e -post