Как выделить повторяющиеся значения в Excel разными цветами?
Пример настраиваемого макроса для выделения повторяющихся значений разным цветом заливки ячеек Excel.
Отмечаем разными цветами ячейки с повторяющимися значениями
Нам нужно чтобы макрос VBA, при помощи разных цветов отмечал в столбце повторяющиеся значения. Более или менее так:
Макрос отмечает повторяющиеся значения более или менее таким образом: Если бы речь шла только о выборе ячеек, данные которых просто повторяются, тогда можно просто использовать условное форматирование. Однако в обсуждаемом примере дело обстоит немного сложнее, потому что необходимо сделать так, чтобы разные значения были отмечены разными цветами. Кроме того, нужно придумать как легко выбирать эти цвета.
Вспомогательный лист (с цветами) выглядит примерно так:
Здесь пользователь может указать свои желаемые пользовательские цвета для подсветки дубликатов.
Установка цветов для подсветки ячеек с дубликатами
Раскрашивая соответствующие ячейки на вспомогательном листе, мы тем самым обозначаем, какими цветами будут отмечены повторяющиеся значения в столбце с данными. Макрос берет поочередно цвета из указанных ячеек, и устанавливает их как цвет фона для каждой из ячеек, имеющих повторяющиеся значения. Если "не хватит" цветов (повторяющихся значений больше, чем определенных цветов), они (цвета) будут просто взяты с начала.
Поскольку лучше сделать так, чтобы ячейки обновлялись каждый раз, когда что-то вводится в ячейку, макрос обрабатывает событие onChange на листе «Данные».
Макрос выглядит следующим образом:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngЦвета As Range
Dim rngК_Покраске As Range
Dim СчетчикЦветов As Integer
Dim Счетчик As Integer
Dim rngСтолбец As Range
Dim rngЗаполненДанные As Range
' диапазон ячеек с цветами
Set rngЦвета = wksВспомогательный.Range("rngColorStart").Resize(wksВспомогательный.Range("settIleColors").Value, 1)
' диапазон с данными для заливки цветом
Set rngК_Покраске = wksДанные.Range(Range("rngDataStart"), Cells(65535, Range("rngDataStart").Column).End(xlUp))
' столбец с данными
Set rngСтолбец = Columns("B")
With wksДанные
Set rngЗаполненДанные = .Range(.Range("rngDataStart"), .Range("rngDataStart").Offset(10000).End(xlUp))
End With
If Not Intersect(Target, rngСтолбец) Is Nothing Then ' если изменение в столбце с данными
Application.ScreenUpdating = False ' выключаю "мигание" экрана
' Очищаем всю область данных (устанавливаем везьде цвет фона по умолчанию)
rngЗаполненДанные.Resize(rngЗаполненДанные.Count + 1).Interior.ColorIndex = _
wksВспомогательный.Range("rngFonStandart").Interior.ColorIndex
СчетчикЦветов = 1 ' сброс счётчика цветов
With rngК_Покраске
' первая ячейка
If Application.WorksheetFunction.CountIf(rngК_Покраске, .Cells(1).Value) > 1 Then
.Cells(1).Interior.ColorIndex = rngЦвета.Cells(СчетчикЦветов).Interior.ColorIndex
СчетчикЦветов = СчетчикЦветов + 1
If СчетчикЦветов > rngЦвета.Count Then СчетчикЦветов = 1
End If
'Если имеется более чем одна ячейка
If rngЗаполненДанные.Count > 1 Then
' это для следующих ячеек
For Счетчик = 2 To .Count
If Application.WorksheetFunction.CountIf(rngК_Покраске, _
.Cells(Счетчик).Value) > 1 Then
If Application.WorksheetFunction.CountIf(Range("rngDataStart").Resize(Счетчик - 1), .Cells(Счетчик).Value) > 0 Then
.Cells(Счетчик).Interior.ColorIndex = _
rngЗаполненДанные.Find(what:=.Cells(Счетчик).Value, after:=.Cells(Счетчик), SearchDirection:=xlPrevious, lookat:=xlWhole).Interior.ColorIndex
Else
.Cells(Счетчик).Interior.ColorIndex = rngЦвета.Cells(СчетчикЦветов).Interior.ColorIndex
СчетчикЦветов = СчетчикЦветов + 1
If СчетчикЦветов > rngЦвета.Count Then СчетчикЦветов = 1
End If
End If
Next Счетчик
End If
End With
Application.ScreenUpdating = True
End If
End Sub
Ниже, как обычно, файл с примером для скачивания:
Скачать выделение повторяющихся значений ячеек разными цветами
Конечно, это не идеальное решение, но в простых случаях оно выполняет свою функцию. Кроме того, оно может послужить вдохновением и отправной точкой для более комплексных решений.
