代码为第1行颜色的dupes颜色只有一个dupe单元格

Question

我想检查Row One

中的欺骗行为

以下代码适用于列范围，例如：

 myrng = Range("C2:C" & Range("C65536").End(xlUp).Row)

 and

 If WorksheetFunction.CountIf(Range("C2:C" & cel.Row), cel) = 1 Then

但是如果我改为第1行，代码只会突出显示重复项的一个单元格

由于

第一行

Sub HilightDupsRow1()
Dim ws As Worksheet
Dim cel As Variant
Dim myrng As Range
Dim clr As Long, LC As Long, cnt1 As Long, cnt2 As Long


    Set ws = ThisWorkbook.Sheets("Nodes")
    With ws
         LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
         Set myrng = .Range(.Cells(1, 1), .Cells(1, LC))

      myrng.Interior.ColorIndex = xlNone
      clr = 3
      For Each cel In myrng
          If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
              If WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(1, cel.Column)) 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 cel
   End With

End Sub

Answer 1

使用Collections获取唯一值，然后遍历集合以突出显示重复项。

Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim LstCol As Long
    Dim c As Long, clr As Long, x, r As Range

    Set sh = ThisWorkbook.Sheets("Nodes")
    With sh

        LstCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set Rng = .Range(.Cells(1, 1), .Cells(1, LstCol))
        Set cUnique = New Collection
        Rng.Interior.ColorIndex = xlNone
        clr = 3

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            For c = 1 To LstCol
                Set r = .Cells(1, c)
                x = Application.WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(1, c)), r)
                If r = vNum Then
                    If x > 1 Then
                        r.Interior.ColorIndex = clr
                    End If
                End If
            Next c
            clr = clr + 1
        Next vNum

    End With

End Sub