Отбор уникальных значений из списка в 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) определяет записываемый элемент в коллекцию, второе определяет добавляемый ключ. Ключ в коллекции не может быть неуникальным, поэтому если он уже есть в коллекции, генерируется ошибка, и цикл переходит к обработке следующей ячейки. Чтобы программа не останавливалась при возникновении ошибок, перед циклом добавлена строка:
Простое и элегантное решение поиска уникальных значений!
Спасибо!
Добрый день!
Странно у меня не срабатывает данный код и выдает ошибку “This key already associated with element of this collection”
Привет, Камалджан!
Строка
должна стоять перед строкой
чтобы пропускать ошибки “This key already associated with element of this collection”, как в исходном коде из этой статьи:
Евгений,
Снимаю шляпу…..
Тонко придумано.
Спасибо
Антон, это решение я подсмотрел у Джона Уокенбаха в книге «Excel 2010: профессиональное программирование на VBA».
Евгений, хорошо было бы привести пример со словарем в дополнение к коллекции.
И рассказать как-нибудь про метод Range.RemoveDuplicates
Привет, Фарин!
Согласен с вашими пожеланиями, принял их к сведению.
Добрый день!
Скажите пожалуйста, чувствителен ли данный метод добавления уникальных значений к регистру?
Я делаю выборку уникальных значений по полю, и значения “Сибирь” и “сибирь” почему то присваиваются одному значению “сибирь”.
Может быть чувствительность как то отключается/включается?
Подскажите пожалуйста )
Добрый день, Андрей!
Ключи объекта Collection нечувствительны к регистру. Если вы хотите отобрать уникальные значения с учетом регистра, используйте код с объектом Dictionary.
Евгений, спасибо большое за ответ! Принял к использованию )
Здравствуйте, очень интересный метод, но это работает только на простом списке? то есть, можно ли применить этот метод для таблицы из 2-3 столбцов с проверкой на уникальность только по одному столбцу?
Здравствуйте, Вольдемар!
Можно удалить из таблицы строки с неуникальными значениями в одном столбце, проверяя уникальность значений снизу вверх:
мда, это ж надо так догадаться, спасибо, Евгений, я бы сам не додумался