excel 2010 vba highlight с различными цветами ячеек с разными значениями дубликатов в нескольких столбцах

Question

Как выделить различные цвета, дублирующие ячейки в excel 2010 на нескольких столбцах. Я нашел этот код, но он работает для одного столбца.

Sub Highlight_Duplicate_Entry() 
     Dim cel As Variant 
     Dim myrng As Range 
     Dim clr As Long 

     Set myrng = Range("A2:A" & Range("A65536").End(xlUp).Row) 
     myrng.Interior.ColorIndex = xlNone 
     clr = 3 

     For Each cel In myrng 
      If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then 
       If WorksheetFunction.CountIf(Range("A2:A" & cel.Row), cel) = 1 Then 
       cel.Interior.ColorIndex = clr 
       clr = clr + 1 
       Else 
       cel.Interior.ColorIndex = myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False), 1).Interior.ColorIndex 
       End If 
      End If 
     Next 
    End Sub 

Answer 1

Вы должны изменить диапазон, чтобы охватить несколько столбцов, которые будут вызывать вашу Match функцию потерпеть неудачу. Замените его на Find. В нижеприведенном разделе будут найдены дубликаты в указанном диапазоне и выделены их другим цветом.

Замените код следующим образом:

Sub Highlight_Duplicate_Entry() 
    Dim ws As Worksheet 
    Dim cell As Range 
    Dim myrng As Range 
    Dim clr As Long 
    Dim lastCell As Range 

    Set ws = ThisWorkbook.Sheets("Sheet1") 
    Set myrng = ws.Range("A2:d" & Range("A" & ws.Rows.Count).End(xlUp).Row) 
    With myrng 
     Set lastCell = .Cells(.Cells.Count) 
    End With 
    myrng.Interior.ColorIndex = xlNone 
    clr = 3 

    For Each cell In myrng 
     If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then 
      ' addresses will match for first instance of value in range 
      If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then 
       ' set the color for this value (will be used throughout the range) 
       cell.Interior.ColorIndex = clr 
       clr = clr + 1 
      Else 
       ' if not the first instance, set color to match the first instance 
       cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex 
      End If 
     End If 
    Next 
End Sub 

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