Для выделения дубликатов, в 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
Вам необходимо выделить диапазон, выбрать цвет для заливки, - и все повторяющиеся значения (или уникальные) будут выделены цветом.
Но таким методом цвет заливки всех ячеек - одинаковый, тем самым выделив все ячейки, которые содержат повторяющие значения, но не найти их.
Чтобы различные повторяющие значение выделились разными цветами - это необходимо реализовать с помощью макроса. Данный Макрос так же работает с выделением всех данных на листе.
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


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