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

时间:2016-02-07 07:37:33

标签: excel excel-2010 excel-2007

感谢您对以下方面的帮助:

我想比较两列,让我们说列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

}

1 个答案:

答案 0 :(得分:0)

这是我在这里回答的调整后的代码。

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

结果

enter image description here

Sample Workbook

编辑:

使用colorindex将我们限制为56种颜色,如果我们使用RGB,我们可以增加它。编辑这部分代码,你必须使用值来获得你喜欢的颜色差异。

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