Как получить список уникальных(не повторяющихся) значений?
Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись - т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами Excel, встроенными формулами и, наконец, при помощи кода Visual Basic for Application(VBA) и сводных таблиц. В этой статье рассмотрим каждый из вариантов.
- При помощи встроенных возможностей Excel 2007 и выше
- При помощи Расширенного фильтра
- При помощи формул
- При помощи кодов Visual Basic for Application(VBA) - макросы, включая универсальный код выборки из произвольного диапазона
- При помощи сводных таблиц
В Excel 2007 и 2010 это сделать проще простого - есть специальная команда, которая так и называется - Удалить дубликаты
Как использовать данную команду. Выделяете столбец(или несколько) с теми данными, в которых надо удалить дублирующие записи. Идете на вкладку Данные
Если выделить один столбец, но рядом с ним будут еще столбцы с данными(или хотя бы один столбец), то Excel предложит выбрать: расширить диапазон выборки этим столбцом или оставить выделение как есть и удалить данные только в выделенном диапазоне. Важно помнить, что если не расширить диапазон, то данные будут изменены лишь в одном столбце, а данные в прилегающем столбце останутся без малейших изменений.
Появится окно с параметрами удаления дубликатов
Ставите галочки напротив тех столбцов, дубликаты в которых надо удалить и жмете Ок. Если в выделенном диапазоне так же расположены заголовки данных, то лучше поставить флаг Мои данные содержат заголовки, чтобы случайно не удалить данные в таблице(если они вдруг полностью совпадают со значением в заголовке).
В случае с Excel 2003 все посложнее. Там нет такого инструмента, как Удалить дубликаты. Но зато есть такой замечательный инструмент, как Расширенный фильтр. В 2003 этот инструмент можно найти в Данные -Фильтр -Расширенный фильтр. Прелесть этого метода в том, с его помощью можно не портить исходные данные, а создать список в другом диапазоне.
Как его использовать: запускаем указанный инструмент - появляется диалоговое окно:

- Обработка: Выбираем Скопировать результат в другое место
(Copy to another location) . - Исходный диапазон
(List range) : Выбираем диапазон с данными(в нашем случае это ).А1:А51 - Диапазон критериев
(Criteria range) : в данном случае оставляем пустым. - Поместить результат в диапазон
(Copy to) : указываем первую ячейку для вывода данных - любую пустую(на картинке - ).E2 - Ставим галочку Только уникальные записи
(Unique records only) . - Жмем Ок.
Примечание: если вы хотите поместить результат на другой лист, то просто так указать другой лист не получится. Вы сможете указать ячейку на другом листе, но...Увы и ах...Excel выдаст сообщение, что не может скопировать данные на другие листы. Но и это можно обойти, причем довольно просто. Надо всего лишь запустить Расширенный фильтр с того листа, на который хотим поместить результат. А в качестве исходных данных выбираем данные с любого листа - это дозволено.
Так же можно не выносить результат в другие ячейки, а отфильтровать данные на месте. Данные от этого никак не пострадают - это будет обычная фильтрация данных.
Для этого надо просто в пункте Обработка выбрать Фильтровать список на месте
Этот способ сложнее в понимании для неопытных пользователей, но зато он создает список уникальных значений, не изменяя при этом исходные данные. Ну и он более динамичен: если изменить данные в исходной таблице, то изменится и результат. Иногда это бывает полезно. Попытаюсь объяснить на пальцах что и к чему: допустим, список с данными у Вас расположен в столбце
Надо отметить, что эта формула является формулой массива. Об этом могут сказать фигурные скобки, в которые заключена данная формула. А вводится такая формула в ячейку сочетанием клавиш -
Тогда вместо ошибки
Чуть подробнее про отличия и нюансы формул ЕСЛИОШИБКА и ЕСЛИ(ЕОШ можно прочесть в этой статье: Как в ячейке с формулой вместо ошибки показать 0
Для пользователей Excel 2021 выше, а так же пользователей Excel 365(с активной подпиской) - использовать формулы для извлечения уникальных элементов проще простого. В этих версиях появилась функция
Что самое важное в данном случае - это функция динамического массива и вводить её надо только в одну ячейку C2, а результат она поместит сама в нужное количество ячеек.
Данный подход потребует разрешения макросов и базовых знаний о работе с ними. Если не уверены в своих знаниях для начала рекомендую прочитать эти статьи:
- Что такое макрос и где его искать?
к статье приложен видеоурок - Что такое модуль? Какие бывают модули?
потребуется, чтобы понять куда вставлять приведенные ниже коды
Оба приведенных ниже кода следует помещать в стандартный модуль. Макросы должны быть разрешены.
Исходные данные оставим в том же порядке - список с данными расположен в столбце "А"(А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:C30").Value |
Или другой столбец:
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Value |
здесь отдельно стоит обратить внимание то, что в данном случае помимо изменения
Код ниже можно применять для любых диапазонов. Достаточно запустить его, указать диапазон со значениями для отбора только неповторяющихся(допускается выделение более одного столбца) и ячейку для вывода результата. Указанные ячейки будут просмотрены, из них будут отобраны только уникальные значения(пустые ячейки при этом пропускаются) и результирующий список будет записан, начиная с указанной ячейки.
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 |
Несколько нестандартный способ извлечения уникальных значений.
- Выделяем один или несколько столбцов в таблице, переходим на вкладку Вставка
(Insert) -группа Таблица(Table) -Сводная таблица(PivotTable) - В диалоговом окне Создание сводной таблицы
(Create PivotTable) проверяем правильность выделения диапазона данных (или установить новый источник данных) - указываем место размещения Сводной таблицы:
- На новый лист
(New Worksheet) - На существующий лист
(Existing Worksheet)
- На новый лист
- подтверждаем создание нажатием кнопки OK
Т.к. сводные таблицы при обработке данных, которые помещаются в область строк или столбцов, отбирают из них только уникальные значения для последующего анализа, то от нас ровным счетом ничего не требуется, кроме как создать сводную таблицу и поместить в область строк или столбцов данные нужного столбца.
- выделил диапазон
на листе Извлечение по критериюA1:B51 - вызвал меню вставки сводной таблицы: вкладка Вставка
(Insert) -группа Таблица(Table) -Сводная таблица(PivotTable)
выбрал вставить на новый лист(New Worksheet) - назвал этот лист Уникальные сводной таблицей
- поле Данные поместил в область строк
- поле ФИО в область фильтра. Почему? Чтобы удобно было выбирать одно или несколько ФИО и в сводной отображался бы список уникальных месяцев только для выбранных фамилий
В чем неудобство работы со сводными в данном случае: при изменении в исходных данных сводную таблицу придется обновлять вручную: Выделить любую ячейку сводной таблицы -Правая кнопка мыши -Обновить
Чтобы лучше понимать все действия и научиться обращаться со сводными таблицами настоятельно рекомендую ознакомиться со статьей Общие сведения о сводных таблицах - к ней приложен видеоурок, в котором я наглядно демонстрирую простоту и удобство работы с основными возможностями сводных таблиц.
В приложенном примере помимо описанных приемов, записана чуть более сложная вариация извлечения уникальных элементов формулой и кодом, а именно: извлечение уникальных элементов по критерию. О чем речь: если в одном столбце фамилии, а во втором(
Tips_All_ExtractUnique.xls (108,0 KiB, 18 517 скачиваний)
Также см.:
Работа с дубликатами
Как подсчитать количество повторений
Общие сведения о сводных таблицах
Статья помогла? Поделись ссылкой с друзьями!

Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Дмитрий, подскажите пожалуйста есть возможность в коде в конце выделить отобранные ячейки для дальнейшей сортировки, и форматирования
или есть ли возможность отобрать сразу отсортированные уникальные значения?
Все можно. Только это требует доработки кода.
Подскажите пожалуйста, как в вашем примере с отбором по критерию, доработать макрос так, чтобы результат отбора вставлялся на строку ниже и пять колонок правее критерия, предполагая что критерий может располагаться в любой ячейке колонки.
Дмитрий воспользовался Вашим кодом для получения уникальных значений . Как получить список из диапазона в моем случае обрабатывается диапазон A2:C. Я прописал код ,а результата нет?
For Each vItem In Range("A2:C", Cells(Rows.Count, 1).End(xlUp)).Selection.Value
Юрий, откуда Selection взялось там, где быть не должно?
Для диапазона столбца А и С:
Спасибо за макрос, но у меня не получается осуществить его авто выполнение. Все расчёты у меня на втором листе, а на первом следующий код:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 Then Extract_Unique
End Sub
по моему замыслу этот макрос запускает Ваш макрос, когда кликаешь на третью колонку первого листа, но этого не происходит - код выдаёт ошибку. подскажите что нужно исправить в коде?
Советую обратиться в форум. Т.к. для определения проблемы надо видеть файл, а не три строки Вашего кода. Здесь выложить файл нет возможности - на форуме есть. Сам код выглядит очень даже верно и должен работать. Где ошибка и какая - не видать...
Дмитрий,
Скажите пожалуйста, как отправить второй макрос (по критерию) отбирать данные на другом листе?
Sub Extract_Unique_for_Criteria()
Dim rCell As Range, avArr, li As Long, vCriteria
ReDim avArr(1 To Rows.Count, 1 To 1)
'Запоминаем критерий
vCriteria = [A5].Value
With New Collection
On Error Resume Next
For Each rCell In Range(Sheets("Испытания").Range("A23"), Cells(Rows.Count, 2).End(xlUp))
If rCell.Offset(, 1).Value = vCriteria Then
'Cells(Rows.Count, 2).End(xlUp) - определяет последнюю заполненную ячейку в столбце B
.Add rCell.Value, CStr(rCell.Value)
If Err = 0 Then
li = li + 1: avArr(li, 1) = rCell.Value
Else: Err.Clear
End If
End If
Next
End With
If li Then [C5].Resize(li).Value = avArr
End Sub
Спасибо
подскажите пожалуйста, как написать в коде, что список лежит не в какой то колонке а в определенном месте - указать лист, и выложить его нужно тоже не просто в колонку, а в другой лист в колонку?
Подскажите, пожалуйста, как формула =ЕСЛИОШИБКА(ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1));"") работает с массивом, имеющим пустые ячейки.
Бился всю ночь - не смог найти решения. Может быть есть подобная, но с учётом отбора только заполненных ячеек?
С пустыми работает на равне с другими. Пустая ячейка является значением 0 или строкой нулевой длины(""). Именно эти значения по одному и будут вставлены в результирующий список. Чтобы пустые ячейки пропускались необходимо эту часть формулы:
СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0
(СЧЁТЕСЛИ($C$1:C1;$A$2:$A$51)=0)*($A$2:$A$51<>"")
записать так:
1. В прилагаемом примере на листе "Простое извлечение" в ячейках Д2 и Д3 не формулы массива, в отличии от остальных в диапазоне Д2-Д17.
2. Всего уникальных значений 12, а строк выделено 16 - это баг или фича?
Виктор, да на листе ошибка. Конечно же, должны быть формулы массива.
Выделено 16 намеренно, чтобы показать какой результат будет у формулы после выбора всех уникальных. В первом столбце - без обхода ошибки, во втором - с обходом.
P.S. Файл перезалил - теперь формулы массива везде, где должны быть.
Здравствуйте, подскажите, пожалуйста, можно ли, используя код VBA (первый из приведенных в статье), получить уникальные значения по сочетаниям данных из двух столбцов (D и N), а затем перенести данные, так же в 2 столбца на другой лист...
Указывала
For Each vItem In Sheets("Stock").Range(Sheets("Stock").Range("D21:N21"), Sheets("Stock").Cells(Sheets("Stock").Rows.Count, 14).End(xlUp)).Value
и
If li Then [H4;J4].Resize(li).Value = avArr
Так тоже писала
For Each vItem In Sheets("Stock").Range(Sheets("Stock").Range("D21,N21"), Sheets("Stock").Cells(Sheets("Stock").Rows.Count, 14).End(xlUp)).Value
Результатом получаю одинаковые столбцы H и J на активном листе, с уникальными значениями отдельно по каждому столбцу, который вошел в указанный диапазон (что, естественно, вполне логично)...
Но вот как указать несвязанный диапазон? Не могу найти на просторах интернета и в ссылках, которые Вы рекомендуете к просмотру.
Борюсь не один час уже с этим... Буду очень благодарна за помощь.
Добрый день,
Спасибо за макросы, Ваш сайт выручал неоднократно! По поводу "Извлечение по критерию" макрос в примере ссылается на ячейку D1 а описание написано C2.
Александр, спасибо, исправил.