I denne artikel vil vi oprette en listeboks i brugerform og indlæse den med værdier efter fjernelse af dublerede værdier.
Rå data, som vi vil indsætte i listeboksen, består af navne. Disse rådata indeholder dobbelthed i definerede navne.
I dette eksempel har vi oprettet en brugerform, der består af listeboks. Denne listeboks viser unikke navne fra eksempeldataene. For at aktivere brugerformularen skal du klikke på knappen Send.
Denne brugerformular returnerer det navn, som brugeren har valgt som output i en meddelelsesboks.
Logisk forklaring
Inden vi tilføjede navne i listeboksen, har vi brugt samleobjekt til at fjerne dublerede navne.
Vi har udført følgende trin for at fjerne dublerede poster:-
-
Tilføjede navne fra det definerede område i Excel -arket til samleobjekt. I indsamlingsobjekt kan vi ikke indsætte dublerede værdier. Samlingsobjekt kaster altså fejl ved at støde på dublerede værdier. For at håndtere fejl har vi brugt fejlmeddelelsen "On Error Resume Next".
-
Efter at have forberedt samlingen skal du tilføje alle genstande fra samlingen til matrixen.
-
Indsæt derefter alle matrixelementerne i listeboksen.
Følg venligst nedenstående for koden
Option Eksplicit sub kører () UserForm1.Show End Sub 'Tilføj nedenstående kode i brugerform Option Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Looping through all the values present in the list box 'Assigning 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 'Unload userform. Unload Me 'Viser den valgte værdi 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 'Clearing the List Box content .Clear' Tilføj værdier i listeboksen For i = 1 Til UBound (MyUniqueList) .AddItem MyUniqueList (i) Næste i ' Valg af det første element .ListIndex = 0 Slut 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 'Deklarere et dynamisk array Dim uList () As Variant 'Deklarerer denne funktion som flygtig' Funktion vil blive genberegnet, når der udføres beregning i en hvilken som helst celle -applikation. Volatil ved fejl Genoptag næste 'tilføjelse af elementer til samling' Kun unikt element indsættes 'Indsættelse af dubleret element vil gennemgå en fejl For hver cl In InputRange If cl.Value "" Herefter 'Tilføjelse af værdier i samlingen cUnique.Add cl.Value, CStr (cl.Value) End If Next cl' Initialiseringsværdi retur med funktionen UniqueItemList = "" If cUnique.Count> 0 Then 'Ændring af matrixstørrelse ReDim uList (1 til cUnique.Count)' Indsættelse af værdier fra samling til array For i = 1 Til cUnique.Count uList (i) = cUnique (i) Næste i UniqueItemList = uList 'Kontrol af værdien af HorizontalList' Hvis værdien er sand, transponerer værdien af UniqueItemList If Not HorizontalList UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End If On Error GoTo 0 End Function
Hvis du kunne lide denne blog, kan du dele den med dine venner på Facebook. Du kan også følge os på Twitter og Facebook.
Vi vil meget gerne høre fra dig, lad os vide, hvordan vi kan forbedre vores arbejde og gøre det bedre for dig. Skriv til os på e -mail -stedet