Отбор уникальных значений из списка в VBA Excel с помощью объекта Collection. Выгрузка уникальных элементов в ListBox и ячейки рабочего листа. Скачать файл с примером кода.
Отбор уникальных значений из списка
При написании макросов для работы с данными в VBA Excel иногда возникает необходимость отбора уникальных значений из списка с повторяющимися элементами. Для этого можно воспользоваться следующим кодом:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
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:
|
20 21 22 |
For Each myElement In myCollection UserForm1.ListBox1.AddItem myElement Next myElement |
ListBox заполнен уникальными значениями из коллекции. Другие способы заполнения ListBox и ComboBox смотрите здесь.
Запись уникальных значений на рабочий лист
А так можно добавить уникальные элементы в ячейки столбца “В” активного рабочего листа:
|
23 24 25 26 |
For Each myElement In myCollection i = i + 1 Cells(i, 2) = myElement Next myElement |
‘при необходимости сортируем полученный список в столбце "В"
|
27 28 |
Range(Cells(1, 2), Cells(i, 2)).Sort Key1:=Range("B1"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom |
‘а также можно отобразить количество найденных уникальных элементов,
‘если, конечно, на форму UserForm1 добавлен элемент управления Label1
|
29 30 31 32 33 34 35 |
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.
Для наглядного ознакомления с работой представленного кода вы можете скачать демонстрационный файл.
Смотрите, как удалить повторяющиеся значения из диапазона ячеек в VBA Excel с помощью метода Range.RemoveDuplicates и отобрать уникальные значения из списка с помощью объекта Dictionary.
Можно ли сделать так :
у меня не получается, помогите пожалуйста, заранее спасибо!
С приветом Холмурод.
Привет, Холмурод. В примере указан диапазон из столбца “B”: Range(Cells(1, 2), Cells(i, 2)). Замените его на диапазон из столбца “A”: Range(Cells(1, 1), Cells(i, 1)).
Привет Евгений.
в ListBox1 список покажет но Sort Key1:=Range(“A30”) в ячейке A30 ничего нет. Сделал вот так:
Холмурод, а вы хотите сделать, чтобы вставленный на лист список начинался с ячейки A30? Если да, то тогда выгрузку на лист надо начать с 30-й ячейки:
и для сортировки указать диапазон, начинающийся с 30-й ячейки:
Евгений огромное Вам спасибо!!!
просто получилось.
Добрый день,
В приведенном примере создаётся коллекция уникальных значений. Все работает. Только я не пойму чем, в какой строке определяется уникальность значений этих значений? Где происходит сравнение ? Ведь, наверное, в коллекцию должны записаться все элементы из Range(“A1:A20”) ?
Привет, Антон.
Уникальность значений проверяется в строке добавления очередного элемента в коллекцию:
Первое выражение CStr(myCell.Value) определяет записываемый элемент в коллекцию, второе определяет добавляемый ключ. Ключ в коллекции не может быть неуникальным, поэтому если он уже есть в коллекции, генерируется ошибка, и цикл переходит к обработке следующей ячейки. Чтобы программа не останавливалась при возникновении ошибок, перед циклом добавлена строка:
Простое и элегантное решение поиска уникальных значений!
Спасибо!
Евгений,
Снимаю шляпу…..
Тонко придумано.
Спасибо
Антон, это решение я подсмотрел у Джона Уокенбаха в книге «Excel 2010: профессиональное программирование на VBA».
Евгений, хорошо было бы привести пример со словарем в дополнение к коллекции.
И рассказать как-нибудь про метод Range.RemoveDuplicates
Привет, Фарин!
Согласен с вашими пожеланиями, принял их к сведению.