Отбор уникальных значений из списка с помощью VBA Excel. Выгрузка отобранных уникальных элементов в ListBox и ячейки рабочего листа. Скачать файл с примером кода.
- Отбор уникальных значений из списка
- Добавление уникальных элементов в ListBox
- Запись уникальных значений на рабочий лист
Отбор уникальных значений из списка
При написании макросов для работы с данными в VBA Excel иногда возникает необходимость отбора уникальных значений из списка с повторяющимися элементами. Для этого можно воспользоваться следующим кодом:
Sub ОтборУникальных()
'Объявляем переменные
'myRange - диапазон ячеек, заполненный исходным списком элементов
'myCell - отдельная ячейка диапазона
'myCollection - коллекция
'myElement - элемент коллекции (должен быть типа "Variant")
Dim myRange As Range, myCell As Range, myCollection As New Collection, _
myElement As Variant, i As Long
'присваиваем переменной myRange диапазон ячеек с исходным списком элементов
Set myRange = Range("A1:A20")
'заполняем новую коллекцию уникальными элементами
On Error Resume Next
For Each myCell In myRange
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
Next myCell
On Error GoTo 0
На этом отбор уникальных значений завершен. Коллекция заполнена уникальными элементами.
Добавление уникальных элементов в ListBox
Теперь можно добавить уникальные значения в ListBox, если перед этим создать форму UserForm1 и на нее добавить элемент управления ListBox1:
For Each myElement In myCollection UserForm1.ListBox1.AddItem myElement Next myElement
ListBox заполнен уникальными значениями из коллекции. Другие способы заполнения ListBox и ComboBox смотрите здесь.
Запись уникальных значений на рабочий лист
А так можно добавить уникальные элементы в ячейки столбца "В" активного рабочего листа:
For Each myElement In myCollection
i = i + 1
Cells(i, 2) = myElement
Next myElement
'при необходимости сортируем полученный список в столбце "В"
Range(Cells(1, 2), Cells(i, 2)).Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'а также можно отобразить количество найденных уникальных элементов,
'если, конечно, на форму UserForm1 добавлен элемент управления Label1
UserForm1.Label1.Caption = _
"Уникальных элементов: " & myCollection.Count
'отображаем форму
UserForm1.Show
End Sub
Если вам необходимо в ListBox или ComboBox загрузить отсортированный список, его элементы можно добавить с листа Excel после сортировки, в данном примере из диапазона Range(Cells(1, 2), Cells(i, 2)).
Обратите внимание, что в представленном коде VBA Excel для отбора уникальных значений из списка, выгрузки их в ListBox и записи на рабочий лист идет сплошная нумерация от Sub ОтборУникальных() и до End Sub.
Для наглядного ознакомления с работой представленного кода вы можете скачать демонстрационный файл.