mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

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

Как известно, в последних версиях 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

Комментарии

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

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

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

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

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

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

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

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

При запуске макроса в Excel 2003 выбираются всего несколько цветов, которые периодически повторяются и они не такие как заданные цвета в коллекции, в том числе выбирается и белый цвет.
Выбираются такие 12632256, 16764108, 13434879,16777164,10079487,13434828,16777215
Попробовал запустить макрос в Excel 2007, там работает как положено, т.е. выбираются те цвета, которые заданы в коллекции.

спасибо

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

Добрый день!
подскажите пожалуйста почему не работает макрос(((( через форматирование выделила все повторяющиеся значения, вставила ваш макрос, выделила столбец, запустила макрос через 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
Подтвердите, пожалуйста, что вы - человек:
  _        ___    _       _____            ___  
| |__ / _ \ | |__ |___ | _ _ / _ \
| '_ \ | (_) | | '_ \ / / | | | | | | | |
| |_) | \__, | | |_) | / / | |_| | | |_| |
|_.__/ /_/ |_.__/ /_/ \__, | \__\_\
|___/
Введите код, изображенный в стиле ASCII-арт.

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

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