使用Excel 2010 VBA，在跨多列的不同重复值的单元格中以不同的颜色突出显示。

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

- Cris Reis

---

请在Excel中使用条件格式。 - user2063626

条件格式将使用相同的颜色突出显示所有重复项。OP希望使用不同的颜色突出显示每组重复项。 - Jon Crowell

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

以下是基于下面的评论添加结果截图以帮助说明如何工作。每个重复项集都用不同的颜色突出显示。不是重复的值没有被着色：

- Jon Crowell

---

你好，非常感谢你的帮助，但是这段代码对于一些未被突出显示的数字无法正常工作。你能否提供更多帮助来解决我的问题？ - Cris Reis

非常感谢，但是对于同一行中的重复数字，代码没有识别出来。我的数据范围（仅包含数字输入）在列中具有唯一数字，但在行中不是这样。 - Cris Reis

现在试试看。现在它应该能够满足你所需要的所有情况。 - Jon Crowell

完美。但是...最后一件事。我如何确定具有最后使用行的列，因为某些列比其他列具有更多的行，然后我将C放在...Range("A" & ws.Rows.Count)...-第8行，因为C是具有更多行的列。非常感谢！！！ - Cris Reis

你做得很对。很高兴它对你有用。你也可以自动化那部分。如果你在SO上搜索“查找最后一行Excel VBA”，你应该会找到一堆有用的选项。 - Jon Crowell