Заполните List Box с уникальными значениями из листа с помощью VBA в Microsoft Excel
В этой статье мы создадим список в форме пользователя и загрузим в него значения после удаления повторяющихся значений.
Исходные данные, которые мы вставим в список, состоят из имен. Эти необработанные данные содержат дублирование определенных имен.
В этом примере мы создали пользовательскую форму, которая состоит из окна списка.
В этом списке будут отображаться уникальные имена из выборки данных. Чтобы активировать пользовательскую форму, нажмите кнопку отправки.
Эта пользовательская форма вернет имя, выбранное пользователем, как вывод в окне сообщения.
Логическое объяснение
Перед добавлением имен в список мы использовали объект коллекции для удаления повторяющихся имен.
Мы выполнили следующие шаги для удаления повторяющихся записей: -. В объект коллекции добавлены имена из определенного диапазона на листе Excel. В объекте коллекции мы не можем вставлять повторяющиеся значения. Итак, объект Collection выдает ошибку при обнаружении повторяющихся значений. Для обработки ошибок мы использовали сообщение об ошибке «On Error Resume Next».
-
После подготовки коллекции добавьте в массив все элементы из коллекции.
-
Затем вставьте все элементы массива в список.
Пожалуйста, введите код ниже
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
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]