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，但它用红色为空白单元格着色（虽然我已经使用条件格式值修复了空白）
当我进行更改时，它不会自动运行VBA或格式化重复单元格，我必须在每次更改后手动运行模块。
我不能为每个人分配颜色，因为我们有100多人为我们租房

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

Answer 1

你能在辅助列B中执行以下操作，然后使用条件格式＆gt;该列上的色标？

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

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

数据布局：

Answer 2

回答你的3个问题

要对空单元格进行着色，只需使用If xCell.Value <> vbNullString Then测试空单元格（参见下面的代码）
另一个问题是只有56 different colors in the color index。你从颜色索引= 2开始（以避免黑白），所以你实际上剩下54种颜色。如果有多于54的副本，则它们的颜色不同，您需要重新开始使用之前已经使用过的颜色。
```
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
```
如果您自动运行它，您可能想要在重新着色之前删除对话框并删除着色：
```
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

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

2 个答案: