Как выделить повторяющиеся значения в excel разными цветами

Выделение в EXCEL дубликатов, встречающихся 3 или 4 раза

Выделим с помощью Условного форматирования только дубликаты , которые встречаются 3 или 4 раза (см. Файл примера ).

• Выделите диапазон содержащий список значений, например, A3:A16 ;
• Вызовите Условное форматирование ( Главная/ Стили/ Условное форматирование/ Создать правило/ Использовать формулу для определения форматируемых ячеек) ;
• Введите формулу =СЧЁТЕСЛИ($A$3:$A$16;$A3)=4
• Выберите нужное форматирование;
• Нажмите ОК

Затем создадим еще одно правило:

• Вызовите Условное форматирование ( Главная/ Стили/ Условное форматирование/ Создать правило/ Использовать формулу для определения форматируемых ячеек) ;
• Введите формулу =СЧЁТЕСЛИ($A$3:$A$16;$A3)=3
• Выберите другое форматирование;
• Нажмите ОК

Значения, повторяющиеся 3 раза, выделены красным; 4 раза – желтым.

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

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

• 81775 просмотров

Приемы и хитрости Microsoft Excel

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

Но таким методом цвет заливки всех ячеек — одинаковый, тем самым выделив все ячейки, которые содержат повторяющие значения, но не найти их.
Чтобы различные повторяющие значение выделились разными цветами — это необходимо реализовать с помощью макроса. Данный Макрос так же работает с выделением всех данных на листе.

Sub ColorsDoubles()
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)) ‘ если надо окрасить всю строку,то cell.EntireRow.Interior.color = cols( CStr (cell.Value))
Next cell
Application.ScreenUpdating = True
End Sub

Как выделить повторяющиеся значения в 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

Ниже, как обычно, файл с примером для скачивания:

Конечно, это не идеальное решение, но в простых случаях оно выполняет свою функцию. Кроме того, оно может послужить вдохновением и отправной точкой для более комплексных решений.

• Excel Formula Examples
• Создать таблицу
• Форматирование
• Функции Excel
• Формулы и диапазоны
• Фильтр и сортировка
• Диаграммы и графики
• Сводные таблицы
• Печать документов
• Базы данных и XML
• Возможности Excel
• Настройки параметры
• Уроки Excel
• Макросы VBA
• Скачать примеры