VBA Excel. Отбор уникальных значений из списка

Опубликовано: 01.09.2018

Отбор уникальных значений из списка с помощью VBA Excel. Выгрузка отобранных уникальных элементов в ListBox и ячейки рабочего листа. Скачать файл с примером кода.

Повторяющиеся значения в Excel — найти, выделить или удалить дубликаты в Excel

Отбор уникальных значений из списка Добавление уникальных элементов в ListBox Запись уникальных значений на рабочий лист

Отбор уникальных значений из списка

При написании макросов для работы с данными в VBA Excel иногда возникает необходимость отбора уникальных значений из списка с повторяющимися элементами. Для этого можно воспользоваться следующим кодом:

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.

Для наглядного ознакомления с работой представленного кода вы можете скачать демонстрационный файл .