Макрос для выделения дубликатов разными цветами

Выделение разными цветами заливки повторяющихся значений (дубликатов)

Как известно, в последних версиях Excel легко выделить дубликаты цветом, - для этого есть специальная опция в «условном форматировании».
Достаточно выделить диапазон, задать цвет заливки, - и все повторяющиеся (или, наоборот, уникальные) значения будут выделены.

Но иногда требуется, чтобы различные повторяющиеся значения были выделены РАЗНЫМИ ЦВЕТАМИ.
В этом случае, без макросов не обойтись.

Ниже приведён макрос, который как раз и решает эту задачу
(достаточно выделить диапазон ячеек, запустить макрос, - и повторяющиеся непустые ячейки получат одинаковый цвет заливки)

Sub ВыделитьДубликатыРазнымиЦветами()
    On Error Resume Next
    ' массив цветов, используемых для заливки ячеек-дубликатов
    Colors = Array(12900829, 15849925, 14408946, 14610923, 15986394, 14281213, 14277081, _
                   9944516, 14994616, 12040422, 12379352, 15921906, 14336204, 15261367, 14281213)
 
    Dim coll As New Collection, dupes As New Collection, _
        cols As New Collection, ra As Range, cell As Range, n&
    Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange)
    If Err Then Exit Sub
 
    ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False
    For Each cell In ra.Cells ' запонимаем значение дубликатов в коллекции dupes
        Err.Clear: If Len(Trim(cell)) Then coll.Add CStr(cell.Value), CStr(cell.Value)
        If Err Then dupes.Add CStr(cell.Value), CStr(cell.Value)
    Next cell
    For i& = 1 To dupes.Count ' заполняем коллекцию cols цветами для разных дубликатов
        n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1
    Next
    For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
        cell.Interior.color = cols(CStr(cell.Value))
    Next cell
    Application.ScreenUpdating = True
End Sub

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Огроооомное спасибо, помогло проанализировать очень большой объем данных! Мучалась на работе бы неделю

А зачем для этого макроса возможность отмены?
Он же не изменяет значения ячеек.
Для отмены, выделяем весь лист, и сбрасываем заливку ячеек (можно для этого записать отдельный макрос из 1 строки кода)

Макрос работает хорошо.
Пробовал изменить код дописав возможность отмены действия макроса - не получилось.
Пытался использовать способ с созданием и удалением резервного листа.
Решение пробовал использовать из этого источника
Было бы здорово реализовать.
Подскажите как если возможно.

Большое спасибо!

Большое спасибо за макрос, это просто чудо!
Моментально всё выделяет даже на тысячах строк.

Большое спасибо!!

Имеется поле суммы столбика В /=СУММ(B1:B23)/, можно сделать так, что эту сумму включались только поля, которые имеют определённый цвет другого поля? Например: при этом столбик А имеет цвет полей от А1 до А10 желтый, а с А11 до А23 красный.Т.Е. что бы автосумм учитывала только поля красного цвета, и при изменении его она пересчитывала результат!!!
Заранее спасибо!

Это гениально!!)спасибо

Огромное спасибо!

Евгений, там много в коде переделывать надо. Это только если под заказ (платно)

Отличный инструмент, спасибо!
Подскажите, что нужно изменить в этом макросе, чтоб закрашивались только те ячейки, которые повторяются не меньше 4-х (5-и, ..., 8-и) раз? Готов каждый раз лазить в макрос и менять на нужное кол-во, только подскажите что и где? (я не спец по макросам, к сожалению).

Огромное спасибо!

Добрый день .Есть большой лист Excel. На нем есть отдельные ячейки с цифрами через запятую от 1 до 99. Каждая ячейка содержит 10 цифр в порядке возрастания. Выглядят ячейки так: 44,48,54,59,60,61,64,73,79,97; 23,32,35,38,41,56,62,63,65,84; и т.д. некоторые ячейки из них с повторяющимися цифрами например: 54,59,61,73,78,81,85,87,93,98; 48,54,59,60,64,68,72,77,85,92; 23,35,41,56,60,67,73,83,94,99

4-5 цифр повторяются, остальные разные. Ячейки в которых совпадают все 10 цифр можно автоматически выделить с помощью условного форматирования.
А вот как сделать так, чтобы подобным образом автоматически выделялись цветом ячейки в каторых совпадают 4 цифры и более?
За раннее спасибо!

Александр, тут макрос нужно писать.
Можем сделать под заказ

Добрый день . Есть большой лист Excel. На нем есть отдельные ячейки с цифрами через запятую от 1 до 99. Каждая ячейка содержит 10 цифр в порядке возрастания. Выглядят ячейки так: 44,48,54,59,60,61,64,73,79,97; 23,32,35,38,41,56,62,63,65,84; и т.д. Но некоторые ячейки из них с повторяющимися цифрами например: 54,59,61,73,78,81,85,87,93,98; 48,54,59,60,64,68,72,77,85,92; 23,35,41,56,60,67,73,83,94,99

4-5 цифр повторяются, остальные разные. Ячейки в которых совпадают все 10 цифр можно автоматически выделить с помощью условного форматирования.
А вот как сделать так, чтобы подобным образом автоматически выделялись цветом ячейки в которых совпадают 4 цифры и более?
За раннее спасибо!

а где макрос? не могу скачать

Всё можно
Но это другом макрос нужен. Можем сделать под заказ

Подскажите, а можно ли сделать? Есть 2 столбца (первый составлен из второго с удалением дублей), мне нужно найти все дубли во втором и только то что дублируется окрасить в цвет и в первом и и во втором в один цвет?

Спасибо, супер макрос, очень помог

Де тут лайк ставить !? спасибо . главное что не режет глаза . единственное нужно убрать серый фон или сделать его потемнее . сливается с белым .

Спасибо!!!

Отлично!
Спасибо за Макрос, все работает и цвета приемлемые не режут глаз!!!

Благодарю за очень полезный макрос!

Добрый день. Спасибо за макрос!
Подскажите пожалуйста,как изменить макрос так, чтоб проверка осуществлялась только в нескольких столбцах и макрос запускался автоматически, при добавлении значения в строке?

Связано с тем, что вы изменили код, удалив первую строку On Error Resume Next

Добрый день! При запуск макроса происходит ошибка run-time 457 в блоке: coll.Add CStr(cell.Value), CStr(cell.Value)
С чем это может быть связано?

Спасибо, Вам, добрый человек! Так меня Ваш макрос выручил!

На данный момент через 56 цветов макрос использует ячейку без цвета а потом снова 56 цветов. Как так сделать что бы он не использовал ячейку без цвета?
Exel 2007

Приветствую!

У меня таблицы по 1000-2000 строк. Хочу увеличить количество и яркость цветов, скажите, пожалуйста, как это сделать? Точнее где взять код цветов?

Подскажите, а как сделать, что бы дубликаты подсвечивались по строке,а не по столбу.

Имею ввиду, что бы дубликаты в одном столбе не светились, а светились только дубликаты по строке

спасибо

Потому что, надо выбрать что-то одно. Если моим макросом пользуетесь, - зачем было условное форматирование использовать?
Макрос мой раскрасил ячейки, - только эта раскраска перекрывается сверху условным форматированием, - потому ничего не видно.

Добрый день!
подскажите пожалуйста почему не работает макрос(((( через форматирование выделила все повторяющиеся значения, вставила ваш макрос, выделила столбец, запустила макрос через Alt+F8 и ничего не изменилось....

Реально помог сегодня! Спасибо!!

Подскажите пож., какая кодировка цветов используется?

спасибо огромное,
вместе с
cell.EntireRow.Interior.Color = cols(CStr(cell.Value))
вообще нереально

Спасибо огромное за макрос!!Очень пригодился!!

Удалите строку Option Explicit
над макросом, — и всё заработает.

Здравствуйте! Скажите пжл, что не пыталась сделать макрос не работает, говорит что не задана переменная Colors, потом не задана i и т.п.

Приветствую!

У меня таблицы по 1000-2000 строк. Хочу увеличить количество и яркость цветов, скажите, пожалуйста, как это сделать? Точнее где взять код цветов?

В макросе прописаны коды цветов:
Colors = Array(12900829, 15849925, и т.д.
Цвета подобраны визуально отличающиеся, и неяркие.
Увеличьте количество значений в этом списке до 200, - разумеется, разных)

здравствуйте! Спасибо огромное за ценный макрос. Не могли бы вы подсказать как изменить макрос так, что бы было больше двухсот цветов для выделения?Заранее спасибо!

Здравствуйте, Денис.

Это в переводе значит «если ячейка непустая, то ...»
можно было записать иначе:

If Len(cell)>0 Then ' если длина текста в ячейке больше нуля (если в ячейке присутствует текст)

А что означает эта конструкция "If Len(Trim(cell)) Then" не могли бы прокомментировать?

Чтобы подсветить целиком строку, а не только ячейку, надо добавить EntireRow:

For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
cell.EntireRow.Interior.Color = cols(CStr(cell.Value))

Супер...Спасибо огромно...

Ваш сайт божественен! СПАСИБО! ОЧень помогли!

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
          _   _          __        __     _    
_ __ (_) | | __ _ \ \ / / / \
| '_ \ | | | | / _` | \ \ /\ / / / _ \
| |_) | | | | | | (_| | \ V V / / ___ \
| .__/ |_| |_| \__, | \_/\_/ /_/ \_\
|_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.