Поиск повторяющихся значений (дубликатов) в одном из столбцов таблицы Excel и выделение их цветом заливки с помощью кода VBA.
Поиск дубликатов в столбце
Чаще всего повторяющиеся значения ищут в первом столбце таблицы, поэтому процедуру поиска дубликатов в VBA Excel рассмотрим именно на нем:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
Sub DuplicateSearch() Dim ps As Long, myRange As Range, i1 As Long, i2 As Long ‘Определяем номер последней строки таблицы ps = Cells(1, 1).CurrentRegion.Rows.Count ‘Нет смысла искать дубликаты в таблице, состоящей из одной строки If ps > 1 Then ‘Присваиваем объектной переменной ссылку на исследуемый столбец Set myRange = Range(Cells(1, 1), Cells(ps, 1)) With myRange ‘Очищаем ячейки столбца от предыдущих закрашиваний .Interior.Color = xlNone For i1 = 1 To ps — 1 For i2 = i1 + 1 To ps If .Cells(i1) = .Cells(i2) Then ‘Если значения сравниваемых ячеек совпадают, ‘обеим присваиваем новый цвет заливки .Cells(i1).Interior.Color = 6740479 .Cells(i2).Interior.Color = 6740479 End If Next Next End With End If End Sub |
После ручного исправления или удаления повторяющихся значений, запускаем процедуру DuplicateSearch вновь, чтобы очистить от заливки ячейки столбца с уникальными значениями и заново выделить оставшиеся дубликаты.
Чтобы найти повторы в другом столбце, замените номер столбца в параметрах свойства Cells (в трех местах процедуры DuplicateSearch).
Константы для заливки
Для указания цвета заливки для ячеек с повторяющимися значениями вместо числового значения цвета можно использовать предопределенные константы:
Предопределенная константа | Наименование цвета |
---|---|
vbBlack | Черный |
vbBlue | Голубой |
vbCyan | Бирюзовый |
vbGreen | Зеленый |
vbMagenta | Пурпурный |
vbRed | Красный |
vbWhite | Белый |
vbYellow | Желтый |
mtts54 Пользователь Сообщений: 164 |
Добрый день, уважаемые форумчане! В поиске есть аналогичные темы, но подходящего мне я не нашел. Суть проблемы: есть табличка ~200 тыс. строк на 60 столбцов. В столбце G — некий идентификатор id, он может быть уникальным, а может повторяться. Буду благодарен за помощь с помощью VBA найти и вырезать из данной таблицы строки с повторяющимися id и перенести их на другой лист. Excel непознаваем как атом. |
Возможно я не правильно понял задачу…. Но самый простой вариант |
|
Если нужен именно макрос, то делаем все тоже самое через макрорекодер (за исключением выделения ячеек отфильтрованных, для копирования). https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=47173 |
|
Jack Famous Пользователь Сообщений: 10848 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
mtts54, здравствуйте! Изменено: Jack Famous — 15.08.2018 11:14:43 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
TheBestOfTheBest Пользователь Сообщений: 2366 Excel 2010 +PLEX +SaveToDB +PowerQuery |
С помощью доп.столбца. Файл положить в папку С:1, на таблице ПКМ-обновить. Неизлечимых болезней нет, есть неизлечимые люди. |
mtts54 Пользователь Сообщений: 164 |
Михаил Комиссаров
, автофильтр «видит» только 10 тыс. строк, поэтому этот прием не годится. Jack Famous , конечный результат в файле-примере таков: на Листе1 строк с подсвеченными id не должно быть — они должны появиться на другом, вставленном листе. В реальном файле из-за большого количества строк УФ неприменимо. Excel непознаваем как атом. |
mtts54 Пользователь Сообщений: 164 |
TheBestOfTheBest
, не совсем то, что необходимо: в Вашем решении одна из повторяющихся строк остается на исходном листе. Мне же нужно ВСЕ строки с повторяющимися id вырезать с исходного листа и вставить на другой лист. Честно говоря, я не понял, каким приемом Вы решили задачу. Спасибо за ответ. Excel непознаваем как атом. |
Jack Famous Пользователь Сообщений: 10848 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#8 15.08.2018 13:19:11 mtts54, пробуйте
UPD (15:05): 14я строка кода Set rng = Cells(1, col).Resize(r+ 1, 1) исправлена на Set rng = Cells(2, col).Resize(r, 1). Файл заменён. Прикрепленные файлы
Изменено: Jack Famous — 15.08.2018 15:07:53 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
|
Ігор Гончаренко Пользователь Сообщений: 13746 |
#9 15.08.2018 14:30:52 выполните этот макрос
при активном листе с данными Изменено: Ігор Гончаренко — 15.08.2018 14:34:29 Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! |
||
TheBestOfTheBest Пользователь Сообщений: 2366 Excel 2010 +PLEX +SaveToDB +PowerQuery |
#10 15.08.2018 14:39:42
Внешний запрос (Данные-Получение внешних данных…). Измените формулу в столбце Ключ =СЧЁТЕСЛИ($G$2:$G$348;G2), обновите таблицы как указано выше. Изменено: TheBestOfTheBest — 15.08.2018 14:40:31 Неизлечимых болезней нет, есть неизлечимые люди. |
||
кузя1972 Пользователь Сообщений: 189 |
#11 15.08.2018 16:37:15 вариант макроса(не нашел как надо в исходном файл -примере),кнопки unic и очистка,лист1 добавлен вручную
Прикрепленные файлы
Изменено: кузя1972 — 15.08.2018 16:37:30 |
||
mtts54 Пользователь Сообщений: 164 |
Коллеги, спасибо за ответы. Сегодня тестировать некогда (комп занят расчетами), отпишусь завтра. Excel непознаваем как атом. |
Jack Famous Пользователь Сообщений: 10848 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
mtts54, мы ждём (ну я точно жду фидбэк) Изменено: Jack Famous — 16.08.2018 10:15:51 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
Nordheim Пользователь Сообщений: 3154 |
#14 16.08.2018 10:51:18 Вариант на массивах и словарях
«Все гениальное просто, а все простое гениально!!!» |
|
mtts54 Пользователь Сообщений: 164 |
Добрый день! Протестировал макрос от Ігор Гончаренко на реальном файле размером 31 колонка на 153 тыс.строк. В макросе в выражениях Offset(0, 9) заменил 9 на 25 и в Columns(16) заменил 16 на 32. Макрос работал ок. 10 минут, нашел все 7696 повторов. Хотелось бы побыстрее, но… размер имеет значение. Спасибо! Остальные решения протестирую завтра. Excel непознаваем как атом. |
mtts54 Пользователь Сообщений: 164 |
Попробовал на том же реальном файле макрос от Jack Famous . К сожалению, макрос где-то зациклился и после 20 минут ожидания я был вынужден остановить его выполнение Excel непознаваем как атом. |
Jack Famous Пользователь Сообщений: 10848 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
#17 17.08.2018 11:45:00 mtts54, немного изменил принцип удаления строк из исходника — пробуйте
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
|
mtts54 Пользователь Сообщений: 164 |
На том же реальном файле макрос Nordheim за 2 секунды нашел все повторы, вставил лист и скопировал повторы туда (правда, пару раз VBA ругнулся: не была объявлена переменная sht1 — это я поправил). Но с исходного листа макрос повторы не удалил Nordheim прочтет этот пост и подправит код Excel непознаваем как атом. |
Jack Famous Пользователь Сообщений: 10848 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome |
mtts54, вы бы выложили ссылку на файл реального объёма, но без конфиденциальных данных — тестить проще было бы Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄ |
Nordheim Пользователь Сообщений: 3154 |
#20 17.08.2018 12:27:31 В данном коде есть нюанс, таблица должна начинаться со второй строки, шапка таблицы на первой
«Все гениальное просто, а все простое гениально!!!» |
||
Kuzmich Пользователь Сообщений: 7998 |
#21 17.08.2018 12:36:19 Nordheim,
при формировании листа Дубли я бы добавил первой строку
Изменено: Kuzmich — 17.08.2018 12:48:30 |
||||
mtts54 Пользователь Сообщений: 164 |
Excel непознаваем как атом. |
kryptonets Пользователь Сообщений: 5 |
Я вижу,что нужен макрос. Но предложу другое решение. Надстройка PowerQuery. Выделить таблицу Ctrl+T, с заголовками.PowerQuery—>Из таблицы,диапазона.Главная—>Сохранять строки—>Сохранять дубликаты.Выгрузить.Готово) |
Nordheim Пользователь Сообщений: 3154 |
#24 17.08.2018 13:03:43
sht1 в файле это название листа в VBAProject, поэтому лист не объявлен, на кириллице неудобно было писать, поэтому переименовал по ходу написания кода «Все гениальное просто, а все простое гениально!!!» |
||
Nordheim Пользователь Сообщений: 3154 |
#25 17.08.2018 13:05:09
С какой целью? «Все гениальное просто, а все простое гениально!!!» |
||
mtts54 Пользователь Сообщений: 164 |
Nordheim
, макрос (с учетом от Kuzmich ) отработал немного дольше (это абсолютно не критично), повторы с исходного листа удалил. Спасибо! kryptonets , нужен именно макрос, т.к. таблица обрабатывается макросом (моим) и прерывать его для ручной работы неудобно. Тем не менее попробую Вашу идею — лишних знаний ведь не бывает, когда-нибудь пригодится. Спасибо. Excel непознаваем как атом. |
Kuzmich Пользователь Сообщений: 7998 |
#27 17.08.2018 13:17:04 Nordheim, написал
Просто на листе Дубли в столбце К появляются ячейки с янв.92 вместо 1-92 Изменено: Kuzmich — 17.08.2018 13:17:18 |
||
Nordheim Пользователь Сообщений: 3154 |
#28 17.08.2018 13:18:40
А строка зачем? «Все гениальное просто, а все простое гениально!!!» |
||
Kuzmich Пользователь Сообщений: 7998 |
#29 17.08.2018 13:22:51 Я имел в виду этот кусок макроса
Чтобы не было преобразования в дату |
||
Nordheim Пользователь Сообщений: 3154 |
#30 17.08.2018 13:23:27 Наверно так более правильно.
Изменено: Nordheim — 17.08.2018 13:25:52 «Все гениальное просто, а все простое гениально!!!» |
||
Очень часто при работе c таблицами Excel возникают ситуации, в которых необходимо сравнить несколько списков, найти в них повторяющиеся значения и что-то с ними сделать. Оптимальный способ поиска и обработки дубликатов должен быть выбран в зависимости от типа исходных данных и желаемого результата. Цель данной статьи — разобрать все возможные варианты обработки дубликатов в Excel в одной статье для того, чтобы читатель мог выбрать оптимальный вариант для любой ситуации.
Оглавление:
- Выделение
- Поиск и выделение повторяющихся значений ячеек в одном списке — условное форматирование
- Поиск и выделение повторяющихся значений ячеек в нескольких списках — условное форматирование
- Поиск и выделение повторяющихся значений ячеек — макрос Excel-VBA
- Поиск и выделение повторяющегося текста внутри ячеек — макрос Excel VBA
- Замена
- Замена дублирующихся значений ячеек с помощью макроса Excel-VBA
- Подстановка в другие таблицы
- Функция ВПР (VLOOKUP)
- Комбинация функций ИНДЕКС + ПОИСКПОЗ (INDEX+MATCH)+СЧЁТ()+ЕСЛИ()
- Подсчёт
- Посчитать количество повторений в одном списке
- Сравнение двух списков используя формулу подсчёта повторений
- Подсчёт количества повторений значений в строках с помощью макросов Excel-VBA
- Функция СЧЁТЕСЛИ (COUNTIF)
- Поиск
- Поиск повторений значений в ячейках с помощью макроса Excel-VBA
- Скрытие
- Сортировка и фильтр
- Скрытие строк с помощью макроса Excel-VBA
- Удаление
- Данные -> удалить дубликаты
- Умные таблицы. Форматировать как таблицу -> удалить дубликаты
Функции в каждом разделе описаны в порядке возрастания их сложности и трудоемкости использования.
Выделение
Поиск и выделение повторяющихся значений ячеек в одном списке — условное форматирование
1. Выделить все значения в списке
2. Вкладка «Главная» -> Условное форматирование -> Правила выделения ячеек -> Повторяющиеся значения
3. Выбрать необходимый формат (в данном случае выбран красный шрифт на светло-красном фоне)
Результат:
Если применить данное условное форматирование ко всему столбцу A, то все новые дубликаты, добавленные после строки 10 также будут отформатированы по заданному правилу.
Поиск и выделение повторяющихся значений ячеек в нескольких списках — условное форматирование
Сначала необходимо выделить столбцы (диапазоны ячеек) с дубликатами. Далее необходимо проделать действия, описанные в предидушем разделе начиная с шага 2.
Недостаток данного способа выделения дубликатов — визуально не определить, продублированы ли значения внутри каждого из списков, или между списками. В данном примере «малина» дублируется внутри списка 1, а «банан» и «груша» выделены потому что они продублированы между списками.
Для того, чтобы дублирование внутри списков воспринималось отдельно от дублирования между списков можно повторно использовать другое условное форматирование для каждого из столбцов по отдельности.
1. Выделяем первый столбец:
2. Вкладка «Главная» -> Условное форматирование -> Правила выделения ячеек -> Повторяющиеся значения
3. Пользовательский формат
4. Выбираем, например, одинарное подчеркивание, жирный шрифт и фиолетовый цвет.
5. Повторяем операцию с шага 2 для столбца B и получаем:
Поиск и выделение повторяющихся значений ячеек — макрос Excel-VBA
Скачать пример в Excel
Sub search_highlight_duplicates()
Dim Arr(16, 1) As String 'сравниваем значения как текст
'массив двухмерный
'16 на 2
'элементы 1-16,0 содержат значения ячеек
'элементы 1-16,1 - является ли соответсвующее значение дубликатом
For i = 1 To 16
Arr(i, 0) = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value 'записываем в массив
Next i
For k = 1 To UBound(Arr, 1)
CurrentItem = Arr(k, 0) 'достаём по одному элементы из массива 1-16,0
For i = 1 To UBound(Arr, 1)
If CurrentItem = Arr(i, 0) And i <> k Then Arr(i, 1) = "COPY"
'сравниваем с другими элементами массива (за исключением себя самого)
'для копий записываем в 1-16,0 "COPY"
Next i
Next k
For i = 1 To UBound(Arr, 1)
ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value = Arr(i, 1)
'запишем результат обратно в таблицу в колонку 2
'либо здесь можно прописать особенное форматирование для каждого элемента исходного массива
Next i
End Sub
То же самое, но через форматирование ячеек:
Скачать пример в Excel
Sub search_highlight_duplicates()
Dim Arr(16, 1) As String
For i = 1 To 16
Arr(i, 0) = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value
Next i
For k = 1 To UBound(Arr, 1)
CurrentItem = Arr(k, 0)
For i = 1 To UBound(Arr, 1)
If CurrentItem = Arr(i, 0) And i <> k Then Arr(i, 1) = "COPY"
Next i
Next k
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) = "COPY" Then
With ThisWorkbook.Sheets("Sheet1").Cells(i, 1)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Font
.Color = -16776961
.TintAndShade = 0
End With
End With
End If
Next i
End Sub
Поиск и выделение повторяющегося текста внутри ячеек — макрос Excel VBA
Возможно существуют и другие более эффективные способы выделения копий слов внутри ячеек, но здесь будет описан только простейший способ, на который натолкнёт запись действий макрорекордером. Если мы напишем длинный текст в ячейке, включим запись макроса и отформатируем часть текста в ячейке, то получим примерно следующее:
Таким образом, для выделения отдельных слов в ячейке нам нужно предварительно найти, где расположен нужный нам набор символов, а также его длину для каждого повторения.
Замена
Замена дублирующихся значений ячеек с помощью макроса Excel-VBA
Подстановка в другие таблицы
Функция ВПР (VLOOKUP)
Об использовании функции ВПР пошагово.
Комбинация функций ИНДЕКС + ПОИСКПОЗ (INDEX+MATCH)+СЧЁТ()+ЕСЛИ()
Если таблица, из которой мы хотим доставать значения для подстановки содержит дубликаты, то использование функции ВПР может не дать нужного результата, так как ВПР использует первое попавшееся совпадение и результат будет зависит от сортировки.
Подсчёт
Посчитать количество повторений в одном списке
Сравнение двух списков используя формулу подсчёта повторений
Подсчёт количества повторений значений в строках с помощью макросов Excel-VBA
Функция СЧЁТЕСЛИ (COUNTIF)
Поиск
Поиск повторений значений в ячейках с помощью макроса Excel-VBA
Скрытие
Сортировка и фильтр
Скрытие строк с помощью макроса Excel-VBA
Удаление
Данные -> удалить дубликаты
Умные таблицы. Форматировать как таблицу -> удалить дубликаты
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
1 |
|
Поиск одинаковых значений в столбце26.09.2011, 14:41. Показов 23032. Ответов 11
Добрый день. Не могу разобраться с одной задачей на Excel. Дан одномерный массив, занесенный в столбец Excel. Необходимо найти количество повторений числа, но только того которое стоит раньше, чем другие числа имеющие повторения…
7 В итоге получается что необходимо посчитать сколько « 5» у нас в массиве. Также нужно посчитать на какой позиции находится первая считаемая цифра (в нашем случае «5» на позиции 2).
0 |
15136 / 6410 / 1730 Регистрация: 24.09.2011 Сообщений: 9,999 |
|
26.09.2011, 15:44 |
2 |
Со вспомогательным столбцом:
2 |
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
26.09.2011, 17:07 [ТС] |
3 |
Спасибо огромное, а как это изобразить в виде макроса?
0 |
19vitek 730 / 406 / 95 Регистрация: 19.12.2010 Сообщений: 756 |
||||||
26.09.2011, 17:43 |
4 |
|||||
Решениекак вариант.
Вложения
1 |
Казанский 15136 / 6410 / 1730 Регистрация: 24.09.2011 Сообщений: 9,999 |
||||
26.09.2011, 17:51 |
5 |
|||
Можно так:
2 |
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
26.09.2011, 19:18 [ТС] |
6 |
спасибо большое!!! Добавлено через 3 минуты ну вроде индекс 1-ой 5 — 2
0 |
19vitek 730 / 406 / 95 Регистрация: 19.12.2010 Сообщений: 756 |
||||
26.09.2011, 19:29 |
7 |
|||
Решение
1 |
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
26.09.2011, 19:37 [ТС] |
8 |
А чтобы вывести только искомые индексы всех 5 как это сделать?
0 |
19vitek 730 / 406 / 95 Регистрация: 19.12.2010 Сообщений: 756 |
||||
26.09.2011, 19:47 |
9 |
|||
1 |
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
26.09.2011, 20:00 [ТС] |
10 |
Не обижайтесь пожалуйста, но меня просто интересует индекс именно второй цифры 5, как его программно запомнить, он мне нужен будет для расчетов….
0 |
19vitek 730 / 406 / 95 Регистрация: 19.12.2010 Сообщений: 756 |
||||
26.09.2011, 20:17 |
11 |
|||
ИМЕННО ВТОРОЙ ИЛИ ПОСЛЕДНЕЙ? Добавлено через 12 минут
1 |
23 / 23 / 12 Регистрация: 13.09.2010 Сообщений: 88 |
|
26.09.2011, 20:57 [ТС] |
12 |
Именно второй Добавлено через 1 минуту
0 |
Skip to content
На чтение 3 мин. Просмотров 4.1k.
Что делает макрос: Всегда хотел выделить значения дубликатов в диапазоне. Макрос в этом разделе делает именно это. Есть много ручных способов найти и выделить дубликаты — способы, включающие формулы, условное форматирование, сортировку и т.д. Тем не менее, все эти методы требуют ручной настройки и определенного уровня обслуживания по мере изменения данных.
Этот макрос упрощает задачу, что позволяет найти и выделить дубликаты в ваших данных с помощью щелчка мыши.
Содержание
- Как макрос работает
- Код макроса
- Как этот код работает
- Как использовать
Как макрос работает
Этот макрос перечисляет ячейки в целевом диапазоне, используя оператор For Each, чтобы активировать каждую ячейку по одной за раз. Затем мы используем функцию СЧЕТЕСЛИ, чтобы подсчитать, сколько раз значение в активной ячейке находится в выбранном
диапазоне. Если это число больше единицы, то формат ячейки — желтого цвета.
Код макроса
Sub VidelitDublikati() 'Шаг 1: Объявляем переменные Dim MyRange As Range Dim MyCell As Range 'Шаг 2: определяем целевой диапазон Set MyRange = Selection 'Шаг 3: запускаем цикл через диапазон For Each MyCell In MyRange 'Шаг 4: Убедить, что ячейка имеет форматирование текста If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then MyCell.Interior.ColorIndex = 36 End If 'Шаг 5: Получаем следующую ячейку в диапазоне Next MyCell End Sub
Как этот код работает
- На шаге 1 объявляются две переменные объекта Range, одна из которых называется MyRange для хранения всей цели диапазона, а другая называется MyCell для хранения каждой ячейки в диапазоне.
- Шаг 2 заполняет переменную MyRange целевым диапазоном. В этом примере мы используем выбранный диапазон — диапазон, который был выбран в электронной таблице. Вы можете легко установить переменную MyRange для определенного диапазона, например Range («A1: Z100»). Кроме того, если ваша цель — именованный диапазон, вы можете просто ввести его имя: Range («MyNamedRange»).
- Шаг 3 макрос начинает проходить по каждой ячейке в целевом диапазоне, активируя каждую ячейку.
- Объект WorksheetFunction позволяет нам запускать многие из Excel функции электронных таблиц в VBA. Шаг 4 использует объект WorksheetFunction для запуска Функция СЧЕТЕСЛИ в VBA.
В этом случае мы рассчитываем, сколько раз значение активной ячейки (MyCell.Value) найдено в заданном диапазоне (MyRange). Если выражение СЧЕТЕСЛИ оценивается больше 1, макрос изменяет цвет ячейки. - Шаг 5 возвращается к следующей ячейке. После активации всех ячеек в целевом диапазоне макрос заканчивается.
Как использовать
Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:
- Активируйте редактор Visual Basic, нажав ALT + F11.
- Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
- Выберите Insert➜Module.
- Введите или вставьте код.