Excel vba поиск уникальных значений в столбце
Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения.
Это может пригодиться, если надо, к примеру, заполнить ComboBox на форме возможными вариантами значений из базы данных:
Код самой функции:
Во вложении - пример использования этой функции в макросе (вывод уникальных записей в другой столбец листа), и пользовательская функция Уникальные - для использования в формулах листа Excel.
Макрос и дополнительная функция из файла во вложении:
Комментарии
Благодарю за Вашу работу. Столкнулся с проблемой выборки дубликатов из массива около 80000 строк и записью строки из 6 значений другого массива на лист ошибок. Решил вопрос доработкой функции UniqueValuesFromArray плюс быстрый поиск ArraySearchResults. Временные показатели очень порадовали 40 секунд вместо 10 минут перебора и выборки из другого массива. Прошу дополнить страницу или создать новую с функцией DoubleValuesFromArray (Поиск уникальных ПОВТОРЯЮЩИХСЯ значений в массиве)
Еще раз спасибо за Вашу работу. Выручали не раз.
Игорь, спасибо!
Подскажите, как доработать функцию так, чтобы уникальные значения переносились в том формате, в котором они находились в начальном массиве? В моем случае начальный массив - это числа, которые выгружаются из другой программы и не отформатированы, как числа, в то время, как переносятся они в виде чисел. Из-за этого в последствии не работает функция ВПР.
Или может быть лучше сделать так, чтобы функция сначала преобразовывала начальный массив в числа и только потом переносила уникальные?
Это потому что вы в другой файл перенесли только часть кода (а код функции UniqueValuesFromArray забыли скопировать)
Добрый день!
На родном файле макрос работает отлично, на другом, с тем же расширением не работает, выдает ошибку Sub or Function not defined на UniqueValuesFromArray. В чем может быть причина?
Расширения обоих файлов поменял на .xlsm
Спасибо!
РАЗОБРАЛСЯ.
СПАСИБО БОЛЬШОЕ ЗА ФУНКЦИЮ1111111
Нет.
выглядит так:
А B
1 текст 1 текст 1
2 текст 2 текст 2
3 текст 3 текст 3
4 текст 4 текст 4
5 текст 5 текст 5
6 текст 6 текст 6
7 текст 7 текст 7
.
33 текст 33 текст 33
34 текст 34 текст 34
35 текст 35 текст 1
36 текст 36 текст 1
37 текст 37 текст 1
и так делее
Т.е. в столбце А я вставил только уникальные значения до строки 80 (текст 80), но на 35 строке функция перестает работать как-будто, может я что не так сделал?
Помогите пожалуйста, я могу это сделать формулами, ног проблема в нагрузке, в моем файле просматриваемый массив имеет длину 2000 строк, excel умирает на расчетах.(((((
Видимо, 36-е значение (которое «первое уникальное») - только с виду похоже на первое
(например, есть лишний пробел, или одна русская буква заменена похожей английской)
Добрый день.
Сразу скажу, что в макросах не че не понимаю.
Мне очень понравилась ваша функция, но появилась проблема.
Функция выбирает 35 уникальных значений, далее возвращает первое уникальное.
В чем проблема?
В статье написано:
пользовательская функция - для использования в качестве формулы массива
выделяете НЕСКОЛЬКО ячеек, вводите эту формулу, и завершаете ввод нажатием Ctrl + Shift + Enter (вместо обычного Enter)
Тогда будет выводиться несколько уникальных значений
А вообще, уникальные можно и формулами вывести, без макросов.
Доброго времени суток. Макрос у меня заработал отлично а вот функция "Уникальные" почему то работает только в файле примере Unique.xls. Ситуация такая: все как положено добавил функцию в модуль, но она на отрез отказывается корректно работать, вместо уникальных значений выдает первое попавшееся значение причем оно возвращается во всех ячейках где прописана функция. Помогите пожалуйста разобраться.
Не знаю, увидите ли вы, но спасибо!
И автору тоже!
Добрый вечер. Разбираю макрос, который здесь представлен. С VBA не работала. Можно ли усложнить функцию вывода уникальных: вывод за период временной с исключением каких-то уникальных значений, т.е. возможно это значение встречается в этот период несколько раз, но выводить его не надо, так как не интересно. Буду очень благодарна за помощь
Добрый день. Разбираю сейчас Ваш макрос. Не сильна в них. Прошу помочь. В целом все работает отлично, но не могу понять как поменять его, чтобы новый массив уникальных вставал на другой (заданный) лист и не столбцом, а строкой. Буду очень признательна за помощь.
Тут самое главное, вот это: On Error Resume Next: Dim coll As New Collection
то есть при ошибке продолжить заполнение коллекции, а так как в коллекцию добавляется ключ такой же как и само значение
txt$ = Trim(cell): If Len(txt$) Then coll.Add txt$, txt$ 'коллекция.добавить значение, ключ
то в коллекции автоматически остается только один уникальный ключ, по определению, и вместе с ним одно уникальное значение
Владимир, ваш вопрос не имеет никакого отношения к теме статьи
В вашем случае, макросы не нужны, - достаточно одной формулы
Обратитесь на любой форум по Excel, прикрепив пример файла, - вам помогут с формулой.
Здравствуйте!
Давно пытаюсь найти решение подобной задачи. Знаний к сожалению не хватает. И вот нашёл Ваш пример. У меня задача хоть и подобная но масштабы больше. В одной книге есть 2 листа:
1 лист (таблица заказов) имеет 159 столбцов с данными, 165 столбец с датой. Каждый столбец с данными пронумерован № продукции 0001,0002,0003, и т.д.0159.
2 лист (отчёт) В отчёте 2 столбец №-ра продукции построчно и 4 столбец для копирования данных продукции с 1 листа.
И вот надо решить задачу: как выбрать продукцию с 1 листа и скопировать во 2 лист по определённой дате заданной во 2 листе.
Вроде бы кажется, что всё просто, но ничего не получается. Прошу Вас подскажите как всё это решить.
Спасибо большое! Действительно быстро работает.
Единственное, что добавил - пропуск пустых ячеек:
For i = LBound(arr) To UBound(arr)
If Trim(arr(i, col)) = "" Then GoTo 1
txt$ = Trim(arr(i, col)): coll.Add txt$, txt$
1: Next i
Function UniqueValuesFromArray может возвращать массив размерностью исходного массива, а не размерностью N * 1?
В дополнительном столбце, при помощи формулы типа =СЦЕПИТЬ(A1;"//";B1), объедините значения этих 2 столбцов,
и потом по этому доп.столбцу отбирайте уникальные
Подскажите пожалуйста, как изменить ваши процедуры, чтобы можно было выбрать уникальные значения не одного столбца, а нескольких. Например в Стобце A значения а,в,а,в. В столбце B в соседних ячейках значения с,д,с,е. Нужно чтобы макрос вдавал массив: В первом столбце: а,в,в. В соседнем с,д,е.
Спасибо! Очень помогло.
Спасибо за функцию.
Работает отлично.
Это уже вторая Ваша функция в течение двух дней, которую я применил в своей работе.
Завтра еще третью буду пробовать - поиск в массиве :)
Еще раз большое спасибо!
Спасибо. Буду изучать.
Так сделать можно, но.
одно дело - выбрать уникальные значения (тут всё ясно, вариантов особо нет),
и совсем другое - выбрать строки с уникальными значениями в каком-то столбце.
К примеру, есть у нас 3 строки с одинаковыми значениями в 1-м столбце.
Какую из этих трёх строк выводить в результат? Первую, третью, вторую?
Пример её использования для вашего случая:
Извините за надоедливость ))
Возни еще один вопрос.
Сейчас выборка уникальный происходит только по столбцу "A".
Возможно ли сделать выборку уникальных по столбцу "A", но с условием, чтобы в диапазон фильтрования попадали также столбцы B и C ?
Т.е. чтобы был аналог функционалу Excel 2007: Выделяю столбцы A,B,C => Данные => Удалить дубликаты => В качестве столбца, по которому будет происходить удаление дубликатов выбираю только столбец A.
Как результат: уникальные значения будут отобраны по столбцу "А", но соответствующие записи из столбцов B и C будут также сохранены.
Вроде разобрался:
Dim ПервыйСтолбец As Range: Set ПервыйСтолбец = Range(Sheets("данные").Range("A1"), Sheets("данные").Range("A" & Rows.Count).End(xlUp))
Подскажите, пожалуйста. Сейчас макрос срабатывает в случае если активен лист с массивом.
Как правильно добавить название листа в запись, чтобы активация листа с массивом не была обязательной?
Я пробовал вот так, но макрос выдает ошибку:
Dim ПервыйСтолбец As Range: Set ПервыйСтолбец = Sheets("данные").Range([A1], Sheets("данные").Range("A" & Rows.Count).End(xlUp))
все прекрасно, только не совсем понятно, что происходит.. вот был бы файлик с работающим примером, там хоть по результату можно было б вычислить, что-куда
Отличный пример использования коллекций для создания массива уникальных записей. Давно использую коллекции, но до этого сам не додумался. И работает быстро ))
Также как и объект Collection, объект Dictionary не допускает добавления двух одинаковых ключей. Эту особенность словаря будем использовать для отбора уникальных значений из списка. Преимущество словаря перед коллекцией заключается в возможности извлечь из него и ключи, и элементы одним массивом.
Традиционный способ отбора
Переменные:
- myDictionary – словарь (объект Dictionary);
- myCell – ячейка диапазона, к которой обращается цикл For Each… Next при очередной итерации;
- myElement – элемент словаря, к которому обращается цикл For Each… Next при выгрузке уникальных значений;
- n – номер очередной строки при выгрузке уникальных значений на рабочий лист.
Нетрадиционный способ отбора
В этом примере используется нетрадиционный способ заполнения словаря. Он заключается в следующем: при присвоении переменной элемента словаря с несуществующим ключом, этот ключ добавляется в словарь со значением элемента Empty.
Самое интересное заключается в том, что при попытке добавить неуникальный ключ, он просто не добавится, а ошибка сгенерирована не будет. Поэтому блоки операторов On Error Resume Next и On Error GoTo 0 не нужны.
При традиционном способе также можно обойтись без строк On Error Resume Next и On Error GoTo 0 , если использовать для отбора свойство Exists объекта Dictionary.
Выгрузка уникальных значений
Способы выгрузки уникальных элементов из объекта Dictionary на рабочий лист Excel уже представлены в примерах традиционного и нетрадиционного отборов. В первом случае используется цикл VBA, во втором – присвоение массива ключей словаря диапазону.
В коде первого примера уникальные значения записываются и как элементы и как ключи, поэтому строку
For Each myElement In myDictionary.Items
можно заменить на
For Each myElement In myDictionary.Keys .
Если в коде второго примера необходимо уникальные значения записать не в столбец, а в строку, следует
Range("B1").Resize(myDictionary.Count) = Application.Transpose(myDictionary.Keys)
заменить на
Range("B1").Resize(, myDictionary.Count) = myDictionary.Keys .
Уникальные элементы из словаря можно выгрузить не только на рабочий лист, но и в динамический массив:
При написании макросов для работы с данными в VBA Excel иногда возникает необходимость отбора уникальных значений из списка с повторяющимися элементами. Для этого можно воспользоваться следующим кодом:
На этом отбор уникальных значений завершен. Коллекция заполнена уникальными элементами.
Добавление уникальных элементов в ListBox
Теперь можно добавить уникальные значения в ListBox, если перед этим создать форму UserForm1 и на нее добавить элемент управления ListBox1:
ListBox заполнен уникальными значениями из коллекции. Другие способы заполнения ListBox и ComboBox смотрите здесь.
Запись уникальных значений на рабочий лист
А так можно добавить уникальные элементы в ячейки столбца «В» активного рабочего листа:
При необходимости сортируем полученный список в столбце "В":
Range ( Cells ( 1 , 2 ) , Cells ( i , 2 ) ) . Sort Key1 : = Range ( "B1" ) , Order1 : = xlAscending , _
А также можно отобразить количество найденных уникальных элементов, если, конечно, на форму UserForm1 добавлен элемент управления Label1:
Если вам необходимо в ListBox или ComboBox загрузить отсортированный список, его элементы можно добавить с листа Excel после сортировки, в данном примере из диапазона Range(Cells(1, 2), Cells(i, 2)).
Обратите внимание, что в представленном коде VBA Excel для отбора уникальных значений из списка, выгрузки их в ListBox и записи на рабочий лист идет сплошная нумерация от Sub ОтборУникальных() и до End Sub.
Для наглядного ознакомления с работой представленного кода вы можете скачать демонстрационный файл.
Смотрите, как удалить повторяющиеся значения из диапазона ячеек в VBA Excel с помощью метода Range.RemoveDuplicates и отобрать уникальные значения из списка с помощью объекта Dictionary.
28 комментариев для “VBA Excel. Отбор уникальных значений с помощью Collection”
Можно ли сделать так :
Range ( Cells ( 1 , 2 ) , Cells ( i , 2 ) ) . Sort Key1 : = Range ( "А51" ) , Order1 : = xlAscending , _
у меня не получается, помогите пожалуйста, заранее спасибо!
С приветом Холмурод.
Привет, Холмурод. В примере указан диапазон из столбца «B»: Range(Cells(1, 2), Cells(i, 2)). Замените его на диапазон из столбца «A»: Range(Cells(1, 1), Cells(i, 1)).
Привет Евгений.
в ListBox1 список покажет но Sort Key1:=Range(«A30») в ячейке A30 ничего нет. Сделал вот так:
Range ( Cells ( 1 , 1 ) , Cells ( i , 1 ) ) . Sort Key1 : = Range ( "A30" ) , Order1 : = xlAscending , Header : = xlGuess , _
Холмурод, а вы хотите сделать, чтобы вставленный на лист список начинался с ячейки 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. Вопросов. Постараюсь в будущем по пустякам не отвлекать).
По существу дела:
MyColl . Add CStr ( c . Value ) , CStr ( c . Value ) 'только повторение CStr(c.Value) дает нужные данные
Хочется узнать:
1. Почему только повторение CStr(c.Value) дает кол-во уникальных знаков, в противном случае дает значение 20 (я почему жду в результате кол-во всех знаков, но без учета пустых ячеек);
2. К моему удивлению макрос выдает данные только с типом возвращ. значений CStr;
3. И если не сложно подсказать куда двигаться: Возможно ли в коллекцию отбирать уже данные с нужными параметрами или для этого нужно использовать другие инструменты?
За ранее, огромное спс.
Добрый день, Дитрий!
1. Первое выражение CStr(c.Value) определяет записываемый элемент в коллекцию, второе определяет добавляемый ключ. Ключ в коллекции не может быть неуникальным, поэтому если он уже есть в коллекции, генерируется ошибка, и цикл переходит к обработке следующей ячейки. Чтобы программа не останавливалась при возникновении ошибок, перед циклом добавлена строка: On Error Resume Next .
2. Элементы коллекции могут содержать разные типы данных, если их не преобразовывать в текст: MyColl.Add c.Value .
3. Я использую коллекции только для отбора уникальных значений, в остальных случаях — массивы. Копирование значений из диапазона ячеек в массив и обратно.
Евгений, от души! Все ясно, я получил исчерпывающий ответ.
P.S. Спасибо за Вашу работу! Этот один из лучших обучающих ресурсов.
Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись - т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами Excel, встроенными формулами и, наконец, при помощи кода Visual Basic for Application(VBA) и сводных таблиц. В этой статье рассмотрим каждый из вариантов.
при помощи встроенных возможностей Excel 2007 и выше
В Excel 2007 и 2010 это сделать проще простого - есть специальная команда, которая так и называется - Удалить дубликаты (Remove Duplicates) . Расположена она на вкладке Данные (Data) подраздел Работа с данными (Data tools)
Как использовать данную команду. Выделяете столбец(или несколько) с теми данными, в которых надо удалить дублирующие записи. Идете на вкладку Данные (Data) -Удалить дубликаты (Remove Duplicates) .
Если выделить один столбец, но рядом с ним будут еще столбцы с данными(или хотя бы один столбец), то Excel предложит выбрать: расширить диапазон выборки этим столбцом или оставить выделение как есть и удалить данные только в выделенном диапазоне. Важно помнить, что если не расширить диапазон, то данные будут изменены лишь в одном столбце, а данные в прилегающем столбце останутся без малейших изменений.
Появится окно с параметрами удаления дубликатов
Ставите галочки напротив тех столбцов, дубликаты в которых надо удалить и жмете Ок. Если в выделенном диапазоне так же расположены заголовки данных, то лучше поставить флаг Мои данные содержат заголовки, чтобы случайно не удалить данные в таблице(если они вдруг полностью совпадают со значением в заголовке).
Способ 1: Расширенный фильтр
В случае с Excel 2003 все посложнее. Там нет такого инструмента, как Удалить дубликаты. Но зато есть такой замечательный инструмент, как Расширенный фильтр. В 2003 этот инструмент можно найти в Данные -Фильтр -Расширенный фильтр. Прелесть этого метода в том, с его помощью можно не портить исходные данные, а создать список в другом диапазоне. В 2007-2010 Excel, он тоже есть, но немного запрятан. Расположен на вкладке Данные (Data) , группа Сортировка и фильтр (Sort & Filter) - Дополнительно (Advanced)
Как его использовать: запускаем указанный инструмент - появляется диалоговое окно:
- Обработка: Выбираем Скопировать результат в другое место (Copy to another location) .
- Исходный диапазон (List range) : Выбираем диапазон с данными(в нашем случае это А1:А51 ).
- Диапазон критериев (Criteria range) : в данном случае оставляем пустым.
- Поместить результат в диапазон (Copy to) : указываем первую ячейку для вывода данных - любую пустую(на картинке - E2 ).
- Ставим галочку Только уникальные записи (Unique records only) .
- Жмем Ок.
Так же можно не выносить результат в другие ячейки, а отфильтровать данные на месте. Данные от этого никак не пострадают - это будет обычная фильтрация данных.
Для этого надо просто в пункте Обработка выбрать Фильтровать список на месте (Filter the list, in-place) .
Чуть подробнее про отличия и нюансы формул ЕСЛИОШИБКА и ЕСЛИ(ЕОШ можно прочесть в этой статье: Как в ячейке с формулой вместо ошибки показать 0
Способ 3: код VBA
Данный подход потребует разрешения макросов и базовых знаний о работе с ними. Если не уверены в своих знаниях для начала рекомендую прочитать эти статьи:
-
к статье приложен видеоурок потребуется, чтобы понять куда вставлять приведенные ниже коды
Оба приведенных ниже кода следует помещать в стандартный модуль. Макросы должны быть разрешены.
Исходные данные оставим в том же порядке - список с данными расположен в столбце " А "( А1:А51 , где А1 - заголовок). Только выводить список мы будем не в столбец С , а в столбец Е , начиная с ячейки Е2 :
Sub Extract_Unique() Dim vItem, avArr, li As Long ReDim avArr(1 To Rows.Count, 1 To 1) With New Collection On Error Resume Next For Each vItem In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value 'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А .Add vItem, CStr(vItem) If Err = 0 Then li = li + 1: avArr(li, 1) = vItem Else: Err.Clear End If Next End With If li Then [E2].Resize(li).Value = avArr End Sub
С помощью данного кода можно извлечь уникальные не только из одного столбца, но и из любого диапазона столбцов и строк. Если вместо строки
Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
указать Selection.Value , то результатом работы кода будет список уникальных элементов из выделенного на активном листе диапазона. Только тогда неплохо бы и ячейку вывода значений изменить - вместо [E2] поставить ту, в которой данных нет.
Так же можно указать конкретный диапазон:
Или другой столбец:
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Value
здесь отдельно стоит обратить внимание то, что в данном случае помимо изменения А2 на С2 изменилась и цифра 1 на 3. Это указание на номер столбца, в котором необходимо определить последнюю заполненную ячейку, чтобы код не просматривал лишние ячейки. Подробнее про это можно прочитать в статье: Как определить последнюю ячейку на листе через VBA?
Универсальный код выбора уникальных значений
Код ниже можно применять для любых диапазонов. Достаточно запустить его, указать диапазон со значениями для отбора только неповторяющихся(допускается выделение более одного столбца) и ячейку для вывода результата. Указанные ячейки будут просмотрены, из них будут отобраны только уникальные значения(пустые ячейки при этом пропускаются) и результирующий список будет записан, начиная с указанной ячейки.
Sub Extract_Unique() Dim x, avArr, li As Long Dim avVals Dim rVals As Range, rResultCell As Range On Error Resume Next 'запрашиваем адрес ячеек для выбора уникальных значений Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A51", Type:=8) If rVals Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'если указана только одна ячейка - нет смысла выбирать If rVals.Count = 1 Then MsgBox "Для отбора уникальных значений требуется указать более одной ячейки", vbInformation, "www.excel-vba.ru" Exit Sub End If 'отсекаем пустые строки и столбцы вне рабочего диапазона Set rVals = Intersect(rVals, rVals.Parent.UsedRange) 'если указаны только пустые ячейки вне рабочего диапазона If rVals Is Nothing Then MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru" Exit Sub End If avVals = rVals.Value 'запрашиваем ячейку для вывода результата Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8) If rResultCell Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'определяем максимально возможную размерность массива для результата ReDim avArr(1 To Rows.Count, 1 To 1) 'при помощи объекта Коллекции(Collection) 'отбираем только уникальные записи, 'т.к. Коллекции не могут содержать повторяющиеся значения With New Collection On Error Resume Next For Each x In avVals If Len(CStr(x)) Then 'пропускаем пустые ячейки .Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка 'если же ошибки нет - такое значение еще не внесено, 'добавляем в результирующий массив If Err = 0 Then li = li + 1 avArr(li, 1) = x Else 'обязательно очищаем объект Ошибки Err.Clear End If End If Next End With 'записываем результат на лист, начиная с указанной ячейки If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr End Sub
Способ 4: Сводные таблицы
Несколько нестандартный способ извлечения уникальных значений.
- Выделяем один или несколько столбцов в таблице, переходим на вкладку Вставка (Insert) -группа Таблица (Table) -Сводная таблица (PivotTable)
- В диалоговом окне Создание сводной таблицы (Create PivotTable) проверяем правильность выделения диапазона данных (или установить новый источник данных)
- указываем место размещения Сводной таблицы:
- На новый лист (New Worksheet)
- На существующий лист (Existing Worksheet)
Т.к. сводные таблицы при обработке данных, которые помещаются в область строк или столбцов, отбирают из них только уникальные значения для последующего анализа, то от нас ровным счетом ничего не требуется, кроме как создать сводную таблицу и поместить в область строк или столбцов данные нужного столбца.
На примере приложенного к статье файла я :- выделил диапазон A1:B51 на листе Извлечение по критерию
- вызвал меню вставки сводной таблицы: вкладка Вставка (Insert) -группа Таблица (Table) -Сводная таблица (PivotTable)
выбрал вставить на новый лист (New Worksheet) - назвал этот лист Уникальные сводной таблицей
- поле Данные поместил в область строк
- поле ФИО в область фильтра. Почему? Чтобы удобно было выбирать одно или несколько ФИО и в сводной отображался бы список уникальных месяцев только для выбранных фамилий
В чем неудобство работы со сводными в данном случае: при изменении в исходных данных сводную таблицу придется обновлять вручную: Выделить любую ячейку сводной таблицы -Правая кнопка мыши -Обновить (Refresh) или вкладка Данные (Data) -Обновить все (Refresh all) -Обновить (Refresh) . А если исходные данные пополняются динамически и того хуже - надо будет заново указывать диапазон исходных данных. И еще один минус - данные внутри сводной таблицы нельзя менять. Поэтому если с полученным списком необходимо будет работать в дальнейшем, то после создания нужного списка при помощи сводной его надо скопировать и вставить на нужный лист.
Чтобы лучше понимать все действия и научиться обращаться со сводными таблицами настоятельно рекомендую ознакомиться со статьей Общие сведения о сводных таблицах - к ней приложен видеоурок, в котором я наглядно демонстрирую простоту и удобство работы с основными возможностями сводных таблиц.
В приложенном примере помимо описанных приемов, записана чуть более сложная вариация извлечения уникальных элементов формулой и кодом, а именно: извлечение уникальных элементов по критерию. О чем речь: если в одном столбце фамилии, а во втором( В ) некие данные(в файле это месяцы) и требуется извлечь уникальные значения столбца В только для выбранной фамилии. Примеры подобных извлечений уникальных расположены на листе Извлечение по критерию.
Tips_All_ExtractUnique.xls (108,0 KiB, 17 726 скачиваний)
Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись - т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами Excel, встроенными формулами и, наконец, при помощи кода Visual Basic for Application(VBA) и сводных таблиц. В этой статье рассмотрим каждый из вариантов.
при помощи встроенных возможностей Excel 2007 и выше
В Excel 2007 и 2010 это сделать проще простого - есть специальная команда, которая так и называется - Удалить дубликаты (Remove Duplicates) . Расположена она на вкладке Данные (Data) подраздел Работа с данными (Data tools)Как использовать данную команду. Выделяете столбец(или несколько) с теми данными, в которых надо удалить дублирующие записи. Идете на вкладку Данные (Data) -Удалить дубликаты (Remove Duplicates) .
Если выделить один столбец, но рядом с ним будут еще столбцы с данными(или хотя бы один столбец), то Excel предложит выбрать: расширить диапазон выборки этим столбцом или оставить выделение как есть и удалить данные только в выделенном диапазоне. Важно помнить, что если не расширить диапазон, то данные будут изменены лишь в одном столбце, а данные в прилегающем столбце останутся без малейших изменений.
Появится окно с параметрами удаления дубликатов
Ставите галочки напротив тех столбцов, дубликаты в которых надо удалить и жмете Ок. Если в выделенном диапазоне так же расположены заголовки данных, то лучше поставить флаг Мои данные содержат заголовки, чтобы случайно не удалить данные в таблице(если они вдруг полностью совпадают со значением в заголовке).
Способ 1: Расширенный фильтр
В случае с Excel 2003 все посложнее. Там нет такого инструмента, как Удалить дубликаты. Но зато есть такой замечательный инструмент, как Расширенный фильтр. В 2003 этот инструмент можно найти в Данные -Фильтр -Расширенный фильтр. Прелесть этого метода в том, с его помощью можно не портить исходные данные, а создать список в другом диапазоне. В 2007-2010 Excel, он тоже есть, но немного запрятан. Расположен на вкладке Данные (Data) , группа Сортировка и фильтр (Sort & Filter) - Дополнительно (Advanced)
Как его использовать: запускаем указанный инструмент - появляется диалоговое окно:- Обработка: Выбираем Скопировать результат в другое место (Copy to another location) .
- Исходный диапазон (List range) : Выбираем диапазон с данными(в нашем случае это А1:А51 ).
- Диапазон критериев (Criteria range) : в данном случае оставляем пустым.
- Поместить результат в диапазон (Copy to) : указываем первую ячейку для вывода данных - любую пустую(на картинке - E2 ).
- Ставим галочку Только уникальные записи (Unique records only) .
- Жмем Ок.
Так же можно не выносить результат в другие ячейки, а отфильтровать данные на месте. Данные от этого никак не пострадают - это будет обычная фильтрация данных.
Для этого надо просто в пункте Обработка выбрать Фильтровать список на месте (Filter the list, in-place) .
Чуть подробнее про отличия и нюансы формул ЕСЛИОШИБКА и ЕСЛИ(ЕОШ можно прочесть в этой статье: Как в ячейке с формулой вместо ошибки показать 0
Способ 3: код VBA
Данный подход потребует разрешения макросов и базовых знаний о работе с ними. Если не уверены в своих знаниях для начала рекомендую прочитать эти статьи:-
к статье приложен видеоурок потребуется, чтобы понять куда вставлять приведенные ниже коды
Оба приведенных ниже кода следует помещать в стандартный модуль. Макросы должны быть разрешены.
Исходные данные оставим в том же порядке - список с данными расположен в столбце " А "( А1:А51 , где А1 - заголовок). Только выводить список мы будем не в столбец С , а в столбец Е , начиная с ячейки Е2 :
Sub Extract_Unique() Dim vItem, avArr, li As Long ReDim avArr(1 To Rows.Count, 1 To 1) With New Collection On Error Resume Next For Each vItem In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value 'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А .Add vItem, CStr(vItem) If Err = 0 Then li = li + 1: avArr(li, 1) = vItem Else: Err.Clear End If Next End With If li Then [E2].Resize(li).Value = avArr End Sub
С помощью данного кода можно извлечь уникальные не только из одного столбца, но и из любого диапазона столбцов и строк. Если вместо строки
Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
указать Selection.Value , то результатом работы кода будет список уникальных элементов из выделенного на активном листе диапазона. Только тогда неплохо бы и ячейку вывода значений изменить - вместо [E2] поставить ту, в которой данных нет.
Так же можно указать конкретный диапазон:Или другой столбец:
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Value
здесь отдельно стоит обратить внимание то, что в данном случае помимо изменения А2 на С2 изменилась и цифра 1 на 3. Это указание на номер столбца, в котором необходимо определить последнюю заполненную ячейку, чтобы код не просматривал лишние ячейки. Подробнее про это можно прочитать в статье: Как определить последнюю ячейку на листе через VBA?
Универсальный код выбора уникальных значений
Код ниже можно применять для любых диапазонов. Достаточно запустить его, указать диапазон со значениями для отбора только неповторяющихся(допускается выделение более одного столбца) и ячейку для вывода результата. Указанные ячейки будут просмотрены, из них будут отобраны только уникальные значения(пустые ячейки при этом пропускаются) и результирующий список будет записан, начиная с указанной ячейки.Sub Extract_Unique() Dim x, avArr, li As Long Dim avVals Dim rVals As Range, rResultCell As Range On Error Resume Next 'запрашиваем адрес ячеек для выбора уникальных значений Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A51", Type:=8) If rVals Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'если указана только одна ячейка - нет смысла выбирать If rVals.Count = 1 Then MsgBox "Для отбора уникальных значений требуется указать более одной ячейки", vbInformation, "www.excel-vba.ru" Exit Sub End If 'отсекаем пустые строки и столбцы вне рабочего диапазона Set rVals = Intersect(rVals, rVals.Parent.UsedRange) 'если указаны только пустые ячейки вне рабочего диапазона If rVals Is Nothing Then MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru" Exit Sub End If avVals = rVals.Value 'запрашиваем ячейку для вывода результата Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8) If rResultCell Is Nothing Then 'если нажата кнопка Отмена Exit Sub End If 'определяем максимально возможную размерность массива для результата ReDim avArr(1 To Rows.Count, 1 To 1) 'при помощи объекта Коллекции(Collection) 'отбираем только уникальные записи, 'т.к. Коллекции не могут содержать повторяющиеся значения With New Collection On Error Resume Next For Each x In avVals If Len(CStr(x)) Then 'пропускаем пустые ячейки .Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка 'если же ошибки нет - такое значение еще не внесено, 'добавляем в результирующий массив If Err = 0 Then li = li + 1 avArr(li, 1) = x Else 'обязательно очищаем объект Ошибки Err.Clear End If End If Next End With 'записываем результат на лист, начиная с указанной ячейки If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr End Sub
Способ 4: Сводные таблицы
Несколько нестандартный способ извлечения уникальных значений.- Выделяем один или несколько столбцов в таблице, переходим на вкладку Вставка (Insert) -группа Таблица (Table) -Сводная таблица (PivotTable)
- В диалоговом окне Создание сводной таблицы (Create PivotTable) проверяем правильность выделения диапазона данных (или установить новый источник данных)
- указываем место размещения Сводной таблицы:
- На новый лист (New Worksheet)
- На существующий лист (Existing Worksheet)
Т.к. сводные таблицы при обработке данных, которые помещаются в область строк или столбцов, отбирают из них только уникальные значения для последующего анализа, то от нас ровным счетом ничего не требуется, кроме как создать сводную таблицу и поместить в область строк или столбцов данные нужного столбца.
На примере приложенного к статье файла я :- выделил диапазон A1:B51 на листе Извлечение по критерию
- вызвал меню вставки сводной таблицы: вкладка Вставка (Insert) -группа Таблица (Table) -Сводная таблица (PivotTable)
выбрал вставить на новый лист (New Worksheet) - назвал этот лист Уникальные сводной таблицей
- поле Данные поместил в область строк
- поле ФИО в область фильтра. Почему? Чтобы удобно было выбирать одно или несколько ФИО и в сводной отображался бы список уникальных месяцев только для выбранных фамилий
В чем неудобство работы со сводными в данном случае: при изменении в исходных данных сводную таблицу придется обновлять вручную: Выделить любую ячейку сводной таблицы -Правая кнопка мыши -Обновить (Refresh) или вкладка Данные (Data) -Обновить все (Refresh all) -Обновить (Refresh) . А если исходные данные пополняются динамически и того хуже - надо будет заново указывать диапазон исходных данных. И еще один минус - данные внутри сводной таблицы нельзя менять. Поэтому если с полученным списком необходимо будет работать в дальнейшем, то после создания нужного списка при помощи сводной его надо скопировать и вставить на нужный лист.
Чтобы лучше понимать все действия и научиться обращаться со сводными таблицами настоятельно рекомендую ознакомиться со статьей Общие сведения о сводных таблицах - к ней приложен видеоурок, в котором я наглядно демонстрирую простоту и удобство работы с основными возможностями сводных таблиц.
В приложенном примере помимо описанных приемов, записана чуть более сложная вариация извлечения уникальных элементов формулой и кодом, а именно: извлечение уникальных элементов по критерию. О чем речь: если в одном столбце фамилии, а во втором( В ) некие данные(в файле это месяцы) и требуется извлечь уникальные значения столбца В только для выбранной фамилии. Примеры подобных извлечений уникальных расположены на листе Извлечение по критерию.
Tips_All_ExtractUnique.xls (108,0 KiB, 17 726 скачиваний)
Читайте также:
- Может ли драйвер для одной операционной системы использоваться в другой
- Какие браузеры поддерживают unity
- Glaux lib как подключить в visual studio
- Evernote web clipper из за ограничений установленных в браузере вы не можете копировать эту страницу
- Компьютерные программы для развития фонематического слуха