自动突出显示具有各种颜色的重复值

Question

我有这些电子表格文件供逾期付款者使用（通常每月 20 次以上）。我想要做的是能够自动格式化不同颜色的重复值。这是我使用的 VBA 代码（来自其他站点）：

Sub ColorCompanyDuplicates()
    'Updateby Extendoffice 20160704

    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long

    On Error Resume Next

    If ActiveWindow.RangeSelection.Count > 1 Then
        xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
        xTxt = ActiveSheet.UsedRange.AddressLocal
    End If

    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection

    For Each xCell In xRg     
        On Error Resume Next

        xCol.Add xCell, xCell.Text
        If Err.Number = 457 Then
            xCIndex = xCIndex + 1
            Set xCellPre = xCol(xCell.Text)
            If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
            xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
        ElseIf Err.Number = 9 Then
            MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
            Exit Sub
        End If

        On Error GoTo 0
    Next  
End Sub

这是一个示例文件： Click here

我遇到的问题是：

我的范围是 A2:L50 但它将空白单元格着色为红色（虽然我已经用空白的条件格式值修复了它）
当我进行更改时，它不会自动运行s VBA 或格式化重复的单元格，我必须在每次更改后手动运行模块。
我无法为每个人分配颜色，因为我们有 100 多人在为我们租房

无论如何，我希望有人能帮我解决这个问题。提前致谢！

Answer 1

您能否在辅助列 B 中执行类似以下操作，然后在该列上使用条件格式 > 色阶？

向下拖动的公式（根据需要修改范围）

=IF(MATCH(A1,$A:$A,0)*IF(COUNTIF($A:$A,A1)>1,1,)>0,MATCH(A1,$A:$A,0)*IF(COUNTIF($A:$A,A1)>1,1,),"")

数据布局：

Answer 2

回答您的 3 个问题

不要为空单元格着色只需使用 If xCell.Value <> vbNullString Then 测试空单元格（参见下面的代码）
另一个问题是只有56 different colors in the color index。您从 color index = 2 开始（以节省黑色和白色），因此您实际上还剩下 54 种颜色。如果重复项的数量超过 54 个，则它们的颜色不能不同，您需要开始 re-using 之前已经使用过的颜色。
```
If xCIndex > 56 Then xCIndex = 2  '(see code below)
```
因此着色将不再是唯一的。

但你应该从总体上考虑一下。因为使用超过 10 种或 15 种颜色并不能使您的工作表更清晰。如果有超过 10 种颜色，我根本看不到不同颜色的任何好处。
运行在任何单元格更改时自动编写代码会使您的工作簿响应速度慢得令人难以置信（如果其中有多个数据行）。所以我建议只运行手动（使用按钮或快捷方式）。
但是您可以尝试运行在 Worksheet_Change 事件中加入它。但我认为那太慢了。
```
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ColorCompanyDuplicates
End Sub
```
如果你运行它自动你可能想要删除对话框并删除之前的着色 re-coloring:
```
Set xRg = Range(xTxt) 'replace the original "Set xRg" line
If xRg Is Nothing Then Exit Sub
xRg.Interior.ColorIndex = xlNone 'remove old coloring
```

这是从 1 和 2 更改的代码部分：

    If xCell.Value <> vbNullString Then 'skip coloring empty cells

        xCol.Add xCell, xCell.Text
        If Err.Number = 457 Then
            xCIndex = xCIndex + 1
            If xCIndex > 56 Then xCIndex = 2 'start re-using colors
            Set xCellPre = xCol(xCell.Text)
            If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
            xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
        ElseIf Err.Number = 9 Then
            MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
            Exit Sub
        End If

    End If

自动突出显示具有各种颜色的重复值

Automatically highlight Duplicate Values with Various colors

excel

vba

conditional-formatting