比较两列并格式化具有不同颜色的匹配单元格

Question

感谢您在以下方面的帮助：

我想比较两列，比如说 A 列和 B 列，**寻找重复项**。

 

如果 A 列中的值与 B 列中的匹配值，我想用颜色格式化相同重复值的单元格（颜色是随机的，每次匹配的颜色不同）。

 

这是如果`A12 = B30`，颜色将为红色。如果 `A20 = B1`，则颜色为绿色，以此类推。

 

如果没有匹配，则保持原样。

 

这只是红色和绿色的一个例子。假设您有两列（A 和 B）。

A1 = 1000

A2 = 2000

A3 = 3000

A4 = 4000

A5 = 5000

A6 = 6000

A7 = 7000

A8 = 8000

A9 = 9000

 

B1 = 1500

B2 = 9000

B3 = 5000

B4 = 3500

B5 = 7500

B6 = 1000

B7 = 4000

 

所以你有几场比赛，我需要每场比赛都是随机的不同颜色。例如：

A1 = B6  –> 它们将以绿色着色/突出显示

A4 = B7   –> 它们将以红色着色/突出显示

A5 = B3 –> 它们将以黄色着色/突出显示

A9 = B2   –> 它们将以粉红色着色/突出显示

 

任何匹配的颜色都会不同，不匹配的颜色会减少或没有变化。

 

我希望这能解释问题，这必须使用 excel。

{

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

Set sh = ActiveSheet
With sh

    LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("A1:B" & LstRw)
    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 Each c In Rng.Cells
            If c = vNum Then
                x = Application.WorksheetFunction.CountIf(Rng, vNum)
                If x > 1 Then c.Interior.ColorIndex = clr "error here: the code runs fine for around 50 lines then it is stoppedand gives error and pointing to this line"
                  //Error shows in pop window: Run-time error 'g': Subscript out of range
            End If
        Next c
        clr = clr + 1
     Next vNum

   End With


End Sub

}

Answer 1

这是根据我的回答调整后的代码。

https://stackoverflow.com/a/33798531/1392235

遍历单元格以查找唯一值，然后遍历唯一值以对重复项着色。

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

    Set sh = ActiveSheet
    With sh

        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range("A1:B" & LstRw)
        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 Each c In Rng.Cells
                If c = vNum Then
                    x = Application.WorksheetFunction.CountIf(Rng, vNum)
                    If x > 1 Then c.Interior.ColorIndex = clr
                End If
            Next c
            clr = clr + 1
        Next vNum

    End With

End Sub

结果

Sample Workbook

编辑：

使用 colorindex 将我们限制为 56 种颜色，如果我们使用 RGB，我们可以增加它。编辑这部分代码，您将不得不使用这些值来获得您喜欢的颜色变化。

       If x > 1 Then c.Interior.Color = 1000000 + clr * 100
            End If
        Next c
        clr = clr + 255