Представим себе большой список различных наименований, ФИО, табельных номеров и т.п. А необходимо из этого списка оставить список все тех же наименований, но чтобы они не повторялись - т.е. удалить из этого списка все дублирующие записи. Как это иначе называют: создать список уникальных элементов, список неповторяющихся, без дубликатов. Для этого существует несколько способов: встроенными средствами 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 выдаст сообщение, что не может скопировать данные на другие листы. Но и это можно обойти, причем довольно просто. Надо всего лишь запустить Расширенный фильтр с того листа, на который хотим поместить результат. А в качестве исходных данных выбираем данные с любого листа - это дозволено.
Так же можно не выносить результат в другие ячейки, а отфильтровать данные на месте. Данные от этого никак не пострадают - это будет обычная фильтрация данных.
Для этого надо просто в пункте Обработка выбрать Фильтровать список на месте
Этот метод создает список уникальных значений, не изменяя при этом исходные данные(изменить формулами исходные данные просто нельзя). Плюс он более динамичен: если изменить данные в исходной таблице, то изменится и результат. Иногда это бывает более удобно, чем постоянно удалять дубли в исходных данных. Попытаюсь объяснить на пальцах что и к чему: допустим, список с данными у нас расположен в столбце
Что самое важное в данном случае - это функция динамического массива и вводить её надо только в одну ячейку C2, а результат она поместит сама в нужное количество ячеек.
А вот для
Надо отметить, что эта формула является формулой массива. Об этом могут сказать фигурные скобки, в которые заключена данная формула. А вводится такая формула в ячейку сочетанием клавиш -
Тогда вместо ошибки
Чуть подробнее про отличия и нюансы формул ЕСЛИОШИБКА и ЕСЛИ(ЕОШ можно прочесть в этой статье: Как в ячейке с формулой вместо ошибки показать 0
- Что такое макрос и где его искать?
к статье приложен видеоурок - Что такое модуль? Какие бывают модули?
потребуется, чтобы понять куда вставлять приведенные ниже коды
Оба приведенных ниже кода следует помещать в стандартный модуль. Макросы должны быть разрешены.
Исходные данные оставим в том же порядке - список с данными расположен в столбце "А"(А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 КиБ, 19 392 скачиваний)
Также см.:
Работа с дубликатами
Как подсчитать количество повторений
Общие сведения о сводных таблицах
Большое СПАСИБО за статью и разъяснения!
Попробовал макрос УНИВЕРСАЛЬНЫЙ КОД ВЫБОРА УНИКАЛЬНЫХ ЗНАЧЕНИЙ, очень хорошо работает. Но хочу спросить, а можно ли конечный список уникальных значений ещё и отсортировать по алфавиту?
Эдуард, это можно сделать и записью макроса. Записали сортировку столбца А, а потом код сортировки останется просто добавить в конец кода.
Попробовал, не получается, две ночи просидел-думал, всю голову сломал, вроде все понятно, но что-то не идёт, знаний-то нет (вообще Excel мне очень- очень интересен, на работе помогает здорово, выручают решения на таких вот форумах, я то там немного кусок у кого-то хватану, то у другого а в целом пока ещё объективных понятий нет. Я в VBA чайниккк). Там получается нужно, чтобы в конце макроса был выделен диапазон с указанной ячейки (я так понимаю rResultCell, но может я ошибаюсь) до последней заполненной в этом столбце и потом произведена сортировка. Отдельно макрос записал: выделяет диапазон с указанной ячейки до последней заполненной, сортирует всё хорошо, но начинаю вставлять в Ваш макрос - стопор. Помогите, пожалуйста.
Можно ли способ 2 использовать на двухмерной таблице (выбирать уники из нескольких столбцов)?
Сергей, не очень понял. Если речь о том, чтобы выбрать из двух столбцов как из одного - нет, такая формула здесь не поможет. Надо "изобретать" другую.
Дмитрий, имел в виду двумерный массив. Короче много столбцов и строк)).
Спасибо, понял вас.
Пока появилась идея: собрать уники по столбцам, потом выстроить их в общий столбец и собрать уники из них. Пока меня это устроит, но хотелось бы автоматом конечно))
Дмитрий, почему если перед началом таблицы добавить пару строчек (т.е. начать диапазон с А4 например), то формула перестаёт работать? Не пойму где ошибка, ведь все диапазоны относительно тоже сдвинулись...
https://www.dropbox.com/s/hs6upjse1tllcpj/excel.PNG?dl=0
Очень полезная информация. Часто пользуюсь макросом, опубликованным в статье. Но иногда необходимо чтобы вставка результатов выполнялась с последней незаполненной ячейки.
( то есть если в "столбце Е" уже имеются какие-то данные то нужно найти последнюю незаполненною ячейку и начиная с неё произвести вставку, уникальных результатов, найденных в "столбце А" )
Подскажете пожалуйста, как должен выглядеть код макроса в таком случаи?
Спасибо!
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
НЕМНОГО НЕПРАВИЛЬНО СФОРМУЛИРОВАЛ ПРЕДЫДУЩИЙ СВОЙ ВОПРОС. АДМИН УДАЛИ ПОЖАЛУЙСТА КОМЕТ ВЫШЕ И ОПУБЛИКУЮ ВМЕСТО НЕГО ЭТОТ.
Очень полезная информация. Часто пользуюсь макросом, опубликованным в статье. Но иногда необходимо чтобы вставка результатов выполнялась с первой незаполненной ячейки.
( то есть если в "столбце Е" уже имеются какие-то данные то нужно найти после этих данных первую пустую ячейку и начиная с неё произвести вставку, уникальных результатов, найденных в "столбце А" )
Подскажете пожалуйста, как должен выглядеть код макроса в таком случаи?
Спасибо!
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
Макрос УНИВЕРСАЛЬНЫЙ КОД ВЫБОРА УНИКАЛЬНЫХ ЗНАЧЕНИЙ просто замечательный, только, пожалуйста, подскажите, как сделать, чтобы уники находились в той же строке, что и родитель, т.к. очень важно их расположение в таблице
Татьяна, если честно, вообще не понял идею. Как это уникальные должны находится в одной строке с родителем? Лучше, наверное, будет обратиться на форум и создать там тему, приложив пример данных и предполагаемого результата.
Дмитрий, спасибо, что отвечаете! Я создала тему, посмотрите, пожалуйста, может посоветуете что-то.
http://www.excel-vba.ru/forum/index.php?board=3.0
Ох, дико извиняюсь) вот правильная ссылка
http://www.excel-vba.ru/forum/index.php?topic=5492.0
Здравствуйте. А мне наоборот нужно оставить только повторяющиеся записи. Как это реализовать? Нужно очистить список от уникальных записей. Помогите пожалуйста(
Дмитрий, подскажите, что добавить в код vba, чтобы он складывал и выводил значения с соседнего столбца?
Добрый день. Прошу помощи. Выделяю диапазон С3:С10, вставляю формулу в С3 "=ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1....", нажимаю Ctrl+Shift+Enter во всех этих ячейках диапазона С3:С10 появляется формула:
{=ИНДЕКС($A$2:$A$51;НАИМЕНЬШИЙ(ЕСЛИ(СЧЁТЕСЛИ($C$1:C1);$A$2:$A$51)=0;СТРОКА($A$1:$A$50));1))}, а по идее нужно получить изменяемую часть "...СЧЁТЕСЛИ($C$1:С2);$A$2:$A$51...", "...СЧЁТЕСЛИ($C$1:С3);$A$2:$A$51..." и т.д. Подскажите последовательность ввода формулы массива, чтобы изменялось С1, С2, С3, С4... Что я делаю не так?
Евгений, введите формулу в одну ячейку, нажмите Ctrl+Shift+Enter. Потом протяните или раскопируйте формулу на нужное кол-во строк.
Дмитрий, добрый день! Помогите, пожалуйста, с первым кодом vba. Задача сделать вывод уникальных значений не в ячейку E2 (как в примере), а в столбец А под основной таблицей с данными. Т.е. координаты будут плавающие и зависеть от количества строк в таблице выше. Спасибо!
Homer, при помощи
Dim llastr&
If li Then Range("A" & llastr).Resize(li).Value = avArr
llastr = Cells(Rows.Count, 1).End(xlUp)
определяете ДО записи последнюю ячейку и потом используете именно эту переменную:
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
Здравствуйте. Помогите подправить код, задача такая.Есть два листа, лист1 архив заказов,и аналогичный лист2 новые заказы, список в листе2 всегда обновляется. В каждом листе есть колонка номер заказа - телефон - фамилия. Как подправить код чтобы перебирались дубликаты по номеру заказа, в случаи нового заказа переносилась вся строка заказа в архив (код заказа - телефон - фамилия)? Важный момент в архиве заказа может отсутствовать информация телефон или фамилия, как сделать так что бы заполнялось не в первую свободную ячейку а переносилась строка целиком, дабы не смещалась информация о телефоне и фамилии?
Александр, с подобным вопросом лучше обратиться вфорум . Создайте там новую тему, опишите проблему и приложите файл с данными. По одному описанию дать готовое решение сложно. Да и вопрос Ваш к теме выбора уникальных не сильно относится - у Вас здесь задача чуть иная.