In diesem Artikel erstellen wir ein Listenfeld in Benutzerform 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 einer Listbox besteht. Dieses Listenfeld zeigt eindeutige Namen aus den Beispieldaten an. Um das Benutzerformular zu aktivieren, klicken Sie auf die Schaltfläche Senden.
Dieses Benutzerformular gibt den vom Benutzer ausgewählten Namen als Ausgabe in einer Meldungsbox zurück.
Logikerklärung
Vor dem Hinzufügen von Namen im Listenfeld haben wir das Sammlungsobjekt verwendet, um doppelte Namen zu entfernen.
Wir haben folgende Schritte durchgeführt, um doppelte Einträge zu entfernen:
-
Namen aus dem definierten Bereich im Excel-Blatt zum Sammlungsobjekt hinzugefügt. Im Sammlungsobjekt können wir keine doppelten Werte einfügen. 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.
-
Nachdem Sie die Sammlung vorbereitet haben, fügen Sie dem Array alle Elemente aus der Sammlung 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 'Unten Code im Benutzerformular hinzufügen Option Explicit Private Sub CommandButton1_Click() Dim var1 As String Dim i As Integer 'Durchlaufen aller Werte im Listenfeld 'Ausgewählten Wert der Variablen zuweisen var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then var1 = ListBox1.List(i) Exit For End If Next 'Entladen des Benutzerformulars. Unload Me 'Ausgewählten Wert anzeigen MsgBox "Sie haben folgenden Namen in der Listbox ausgewählt: " & var1 End Sub Private Sub UserForm_Initialize() Dim MyUniqueList As Variant, i As Long 'Aufruf der UniqueItemList-Funktion 'Zuweisung des Bereichs als Eingabeparameter MyUniqueList = UniqueItemList(Range("A12:A100"), True) With Me.ListBox1 'Löschen des Listbox-Inhalts .Clear 'Hinzufügen von Werten in die Listbox For i = 1 To UBound(MyUniqueList) .AddItem MyUniqueList(i) Next i ' Auswahl des ersten Elements .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 'Dynamisches Array deklarieren Dim uList() As Variante 'Diese Funktion als flüchtig deklarieren 'Dies bedeutet, dass die Funktion jedes Mal neu berechnet wird, wenn die Berechnung in einer Zelle erfolgt Application.Volatile On Error Resume Next 'Elemente zur Sammlung hinzufügen 'Nur eindeutige Elemente werden eingefügt 'Das Einfügen von doppelten Elementen führt zu einem Fehler für jeden cl In InputRange If cl.Value "" Then 'Hinzufügen von Werten in Sammlung cUnique.Add cl.Value, CStr(cl.Value) End If Next cl 'Wertrückgabe durch die Funktion UniqueItemList = "" initialisieren If cUnique.Count > 0 Then 'Größe des Arrays ändern ReDim uList(1 To cUnique.Count) 'Einfügen von Werten aus der Sammlung in das Array For i = 1 To cUnique.Count uList(i) = cUnique(i) Next i UniqueItemList = uList 'Überprüfen des Wertes von HorizontalList ' Wenn der Wert wahr ist, dann transponieren Sie den Wert von UniqueItemList If Not HorizontalList Then UniqueItemList = _ Application.WorksheetFunction.Transpose(UniqueItemList) End If End If On Error GoTo 0 End Function
Wenn Ihnen dieser Blog gefallen hat, teilen Sie ihn mit Ihren Freunden auf Facebook. Außerdem können Sie uns auf Twitter und Facebook folgen.
Wir würden uns freuen, von Ihnen zu hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns auf der E-Mail-Site