Отбор уникальных значений из списка в 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 |
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 столбцов с проверкой на уникальность только по одному столбцу?
Здравствуйте, Вольдемар!
Можно удалить из таблицы строки с неуникальными значениями в одном столбце, проверяя уникальность значений снизу вверх:
мда, это ж надо так догадаться, спасибо, Евгений, я бы сам не додумался
Добрый день, а как сделать так, чтобы уникальные ячейки загружались на лист в определенный столбец?
Привет, Вадим!
В выражении
i = 10 - 1число 10 указывает, что заполнение столбца начнется с 10 строки. Если заполнение должно начаться с первой ячейки заданного столбца, это выражение следует исключить из процедуры.В выражении
Worksheets("Лист1").Cells(i, "D") = myElement:"Лист1"– наименование ярлыка листа, в ячейки которого будут вставляться уникальные значения;"D"– буквенное обозначение столбца, который будет заполняться (можно заменить на числовое значение: 1 вместо «A», 2 вместо «B» и т.д.).Здравствуйте, помогите пожалуйста нужен код для получения уникального списка по критерию в соседнем столбце
Добрый день. Помогите пож. «Играюсь» с Collection. При попытке вывести кол-во членов коллекции через Collection.Count Программа выдает кол-во строк указанного диапазона(( , а не кол-во знаков в диапазоне. И только повтором типа myCollection.Add CStr(myCell.Value), CStr(myCell.Value) MsgBox выдает кол-во членов коллекции корректно. Почему??((
Здравствуйте, Дитрий!
Пример кода, пожалуйста.
Евгений, добрый день! Только начинаю изучать VBA. Вопросов!!! Постараюсь в будущем по пустякам не отвлекать).
По существу дела:
Хочется узнать:
1. Почему только повторение CStr(c.Value) дает кол-во уникальных знаков, в противном случае дает значение 20 (я почему жду в результате кол-во всех знаков, но без учета пустых ячеек);
2. К моему удивлению макрос выдает данные только с типом возвращ. значений CStr;
3. И если не сложно подсказать куда двигаться: Возможно ли в коллекцию отбирать уже данные с нужными параметрами или для этого нужно использовать другие инструменты?
За ранее, огромное спс.!!!
Добрый день, Дитрий!
1. Первое выражение CStr(c.Value) определяет записываемый элемент в коллекцию, второе определяет добавляемый ключ. Ключ в коллекции не может быть неуникальным, поэтому если он уже есть в коллекции, генерируется ошибка, и цикл переходит к обработке следующей ячейки. Чтобы программа не останавливалась при возникновении ошибок, перед циклом добавлена строка:
On Error Resume Next.2. Элементы коллекции могут содержать разные типы данных, если их не преобразовывать в текст:
MyColl.Add c.Value.3. Я использую коллекции только для отбора уникальных значений, в остальных случаях — массивы. Копирование значений из диапазона ячеек в массив и обратно.
Евгений, от души! Все ясно, я получил исчерпывающий ответ.
P.S. Спасибо за Вашу работу! Этот один из лучших обучающих ресурсов!!!
Добрый день! Подскажите, пожалуйста, как можно реализовать следующую задачу. В столбце А есть набор значений, некоторые из которых повторяются, в столбце B набор соответствующие им уникальные значения. В столбец C нужно вывести 1) если значение в столбце А уникальное — то значение из столбца B 2) если значение не уникальное — среднее арифметическое по всем соответствующим этому значению из столбца B.
Спасибо заранее!
Добрый день!
Всё понятно по коду, работает, спасибо большое!
Вопрос: что делает «On Error GoTo 0»?
Погуглил: «Отключает любой включенный обработчик ошибок в текущей процедуре.» Ни о чём не говорит) Подскажите на пальцах, пожалуйста. В связи с чем возник вопрос: если удалить эту строку, то ничего не происходит, код работает как и работал.
В чём смысл строки? Заранее благодарю за ответ!
Здравствуйте, Пётр!
Выражение «On Error Resume Next» включает обработчик ошибок, который при возникновении ошибки игнорирует ее и передает управление следующей строке. Если не добавить «On Error GoTo 0», то ошибки, которые могут возникнуть при выполнении нижележащих строк кода, также будут проигнорированы.
Спасибо большое! Просто и ясно!