Wypełnij pole listy unikalnymi wartościami z arkusza roboczego za pomocą VBA w programie Microsoft Excel

Anonim

W tym artykule utworzymy pole listy w formie użytkownika i załadujemy go wartościami po usunięciu zduplikowanych wartości.

Surowe dane, które wstawimy w List Box, składają się z nazw. Te surowe dane zawierają duplikaty w zdefiniowanych nazwach.

W tym przykładzie stworzyliśmy formularz użytkownika, który składa się z pola listy. To pole listy wyświetli unikalne nazwy z przykładowych danych. Aby aktywować formularz użytkownika, kliknij przycisk Prześlij.

Ten formularz użytkownika zwróci nazwę wybraną przez użytkownika jako dane wyjściowe w oknie komunikatu.

Wyjaśnienie logiczne

Przed dodaniem nazw w polu listy użyliśmy obiektu kolekcji do usunięcia zduplikowanych nazw.

Wykonaliśmy następujące kroki, aby usunąć zduplikowane wpisy:-

  1. Dodano nazwy ze zdefiniowanego zakresu w arkuszu Excel do obiektu kolekcji. W obiekcie kolekcji nie możemy wstawić zduplikowanych wartości. Tak więc obiekt Collection zgłasza błąd w przypadku napotkania zduplikowanych wartości. Aby poradzić sobie z błędami, użyliśmy komunikatu o błędzie „On Error Resume Next”.

  2. Po przygotowaniu kolekcji dodaj wszystkie elementy z kolekcji do tablicy.

  3. Następnie wstaw wszystkie elementy tablicy do pola listy.

Proszę postępować zgodnie z poniższym kodem!

 Option Explicit Sub running() UserForm1.Show End Sub 'Dodaj poniższy kod w formularzu użytkownika Option Explicit Private Sub CommandButton1_Click() Dim var1 As String Dim i As Integer 'Przechodzenie w pętlę przez wszystkie wartości znajdujące się w polu listy 'Przypisywanie wybranej wartości do zmiennej var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then var1 = ListBox1.List(i) Exit For End If Next 'Zwolnij formularz użytkownika. Unload Me 'Wyświetlanie wybranej wartości MsgBox "Wybrałeś następującą nazwę w polu listy: " & var1 End Sub Private Sub UserForm_Initialize() Dim MyUniqueList As Variant, i As Long 'Calling UniqueItemList function 'Przypisywanie zakresu jako parametru wejściowego MyUniqueList = UniqueItemList(Range("A12:A100"), True) With Me.ListBox1 'Czyszczenie zawartości pola listy .Clear 'Dodawanie wartości w polu listy For i = 1 To UBound(MyUniqueList) .AddItem MyUniqueList(i) Next i ' Wybór pierwszego elementu .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 'Deklarowanie tablicy dynamicznej Dim uList() As Wariant 'Deklarowanie tej funkcji jako nietrwałej' Oznacza, że ​​funkcja będzie obliczana ponownie za każdym razem, gdy obliczenia zostaną wykonane w dowolnej komórce Aplikacja.Niestabilny w przypadku błędu Wznów Dalej 'Dodawanie elementów do kolekcji 'Tylko unikalny element zostanie wstawiony 'Wstawienie zduplikowanego elementu spowoduje błąd Dla każdego cl In InputRange If cl.Value "" Then 'Dodawanie wartości w kolekcji cUnique.Add cl.Value, CStr(cl.Value) End If Next cl 'Inicjowanie zwracania wartości przez funkcję UniqueItemList = "" If cUnique.Count > 0 Then 'Zmiana rozmiaru tablicy ReDim uList(1 To cUnique.Count) 'Wstawianie wartości z kolekcji do tablicy For i = 1 To cUnique.Count uList(i) = cUnique(i) Next i UniqueItemList = uList 'Sprawdzanie wartości HorizontalList ' Jeśli wartość to prawda, to transpozycja wartości UniqueItemList Jeśli nie HorizontalList Then UniqueItemList = _ Application.WorksheetFunction.Transpose(UniqueItemList) End If End If On Error GoTo 0 End Function 

Jeśli podobał Ci się ten blog, podziel się nim ze znajomymi na Facebooku. Możesz również śledzić nas na Twitterze i Facebooku.

Chcielibyśmy usłyszeć od Ciebie, daj nam znać, jak możemy poprawić naszą pracę i uczynić ją lepszą dla Ciebie. Napisz do nas na stronie e-mail