Füllen Sie ein Listenfeld mit eindeutigen Werten aus einem Arbeitsblatt mit VBA in Microsoft Excel
In diesem Artikel erstellen wir ein Listenfeld im Benutzerformular und laden es mit Werten, nachdem doppelte Werte entfernt wurden.
Rohdaten, die wir in das Listenfeld einfügen, bestehen aus Namen. Diese Rohdaten enthalten Duplizität in definierten Namen.
In diesem Beispiel haben wir ein Benutzerformular erstellt, das aus einem Listenfeld besteht.
In diesem Listenfeld werden eindeutige Namen aus den Beispieldaten angezeigt. Um das Benutzerformular zu aktivieren, klicken Sie auf die Schaltfläche Senden.
Dieses Benutzerformular gibt den vom Benutzer ausgewählten Namen als Ausgabe in einem Meldungsfeld zurück.
Logische Erklärung
Vor dem Hinzufügen von Namen im Listenfeld haben wir das Sammlungsobjekt verwendet, um doppelte Namen zu entfernen.
Wir haben die folgenden Schritte ausgeführt, um doppelte Einträge zu entfernen: -. Namen aus dem definierten Bereich in der Excel-Tabelle zum Sammlungsobjekt hinzugefügt. Im Sammlungsobjekt können keine doppelten Werte eingefügt werden. Das Collection-Objekt gibt also einen Fehler aus, wenn doppelte Werte gefunden werden. Um Fehler zu behandeln, haben wir die Fehleranweisung „On Error Resume Next“ verwendet.
-
Fügen Sie nach dem Vorbereiten der Sammlung alle Elemente aus der Sammlung zum Array hinzu.
-
Fügen Sie dann alle Array-Elemente in das Listenfeld ein.
Bitte folgen Sie unten für den Code
Option Explicit
Sub running()
UserForm1.Show
End Sub
'Add below code in userform
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 the userform.
Unload Me
'Displaying the selected value
MsgBox "You have selected following name in the List Box : " & 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
'Selecting the first item
.ListIndex = 0
End With
End Sub
Private Function UniqueItemList(InputRange As Range, _
HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, i As Long
'Declaring a dynamic array
Dim uList() As Variant
'Declaring this function as volatile
'Means function will be recalculated whenever calculation occurs in any cell
Application.Volatile
On Error Resume Next
'Adding items to collection
'Only unique item will be inserted
'Inserting duplicate item will through an error
For Each 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
'Resizing the array size
ReDim uList(1 To cUnique.Count)
'Inserting values from collection to array
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
'Checking the value of HorizontalList
'If value is true then transposing value of UniqueItemList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
Wenn dir dieser Blog gefallen hat, teile ihn mit deinen Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]