Как известно, в последних версиях 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
Комментарии
Де тут лайк ставить !? спасибо . главное что не режет глаза . единственное нужно убрать серый фон или сделать его потемнее . сливается с белым .
Спасибо!!!
Отлично!
Спасибо за Макрос, все работает и цвета приемлемые не режут глаз!!!
Благодарю за очень полезный макрос!
Добрый день. Спасибо за макрос!
Подскажите пожалуйста,как изменить макрос так, чтоб проверка осуществлялась только в нескольких столбцах и макрос запускался автоматически, при добавлении значения в строке?
Связано с тем, что вы изменили код, удалив первую строку 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(Trim(cell)) Then" не могли бы прокомментировать?
Чтобы подсветить целиком строку, а не только ячейку, надо добавить EntireRow:
For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
cell.EntireRow.Interior.Color = cols(CStr(cell.Value))
Супер...Спасибо огромно...
Ваш сайт божественен! СПАСИБО! ОЧень помогли!
Отправить комментарий