Excel 突出显示基于特定单元格匹配的行

如果我在这里期望太高，请原谅，但我想一定有比我现在做的更快的方法

因此，我有一些电子表格，我必须根据某些列中的标准对行进行排序和匹配（在本例中，比较了

F

、

G

、

H

、

I

、

J

和

K

）并高亮显示匹配行的颜色，使其与其他行不同，然后继续此操作，直到每一行都着色。下面是我所需要的开始数据和理想结束的图像

Sub Highlight_Duplicate_Entry()

Range("AA2").Select
ActiveCell.FormulaR1C1 = _
    "=CONCATENATE(RC[-13],RC[-12],RC[-11],RC[-10],RC[-9],RC[-8])"
Range("AA2").Select
Selection.AutoFill Destination:=Range("AA2:AA279"), Type:=xlFillDefault
Range("AA2:AA400").Select


Dim cel As Variant
Dim myrng As Range
Dim clr As Long
Set myrng = Range("AA2:AA" & Range("AA65536").End(xlUp).Row)
myrng.Interior.ColorIndex = xlNone
clr = 36
For Each cel In myrng
    If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
        If WorksheetFunction.CountIf(Range("AA2:AA" & cel.Row), cel) = 1 Then
            cel.EntireRow.Interior.ColorIndex = clr
            clr = clr + 1
        Else
            cel.EntireRow.Interior.ColorIndex =      myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False),        1).Interior.ColorIndex
        End If
    End If
Next

lRow = Range("AA" & Rows.Count).End(xlUp).Row
 Set MR = Range("AA2:AA" & lRow)
 For Each cell In MR
 If cell.Value Like "*SMLS*" Then cell.EntireRow.Interior.ColorIndex = 20


Next
    Columns("AA:AA").Select
Selection.ClearContents
Range("K2").Select

 End Sub

我的问题来自于不知道如何告诉它查看和比较适当的列。如果我告诉它只看一列，我就能让它工作。例如，如果我只看列

J

，我就可以让它工作，但正如您在图片中看到的，列

J

在其他列中可能有不同的变量，这会导致它的颜色不同。我希望这里的人可能知道一种更简单的方法，因为我已经为此挣扎了几天，似乎没有什么进展

下面是我在网上找到的代码，它可以基于一个变量更改行。使用此代码，它将在列

J

中看到RRR，并高亮显示所有具有RRR的行，即使它们在其他列中匹配

Sub ChangeColor()
lRow = Range("F" & Rows.Count).End(xlUp).Row
Set MR = Range("F2:K" & lRow)
For Each cell In MR
If cell.Value Like "*RRR*" Then cell.EntireRow.Interior.ColorIndex = 20


    Next
End Sub

（）

编辑！ 因此，我能够根据这里的一些反馈和想法拼凑出一个工作代码。这并不是最漂亮的，但是用户Byron有一个惊人的更短更快的代码，我可以修改它来获得我需要的

Sub Highlight_Duplicate_Entry()

Range("AA2").Select
ActiveCell.FormulaR1C1 = _
    "=CONCATENATE(RC[-13],RC[-12],RC[-11],RC[-10],RC[-9],RC[-8])"
Range("AA2").Select
Selection.AutoFill Destination:=Range("AA2:AA279"), Type:=xlFillDefault
Range("AA2:AA400").Select


Dim cel As Variant
Dim myrng As Range
Dim clr As Long
Set myrng = Range("AA2:AA" & Range("AA65536").End(xlUp).Row)
myrng.Interior.ColorIndex = xlNone
clr = 36
For Each cel In myrng
    If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
        If WorksheetFunction.CountIf(Range("AA2:AA" & cel.Row), cel) = 1 Then
            cel.EntireRow.Interior.ColorIndex = clr
            clr = clr + 1
        Else
            cel.EntireRow.Interior.ColorIndex =      myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False),        1).Interior.ColorIndex
        End If
    End If
Next

lRow = Range("AA" & Rows.Count).End(xlUp).Row
 Set MR = Range("AA2:AA" & lRow)
 For Each cell In MR
 If cell.Value Like "*SMLS*" Then cell.EntireRow.Interior.ColorIndex = 20


Next
    Columns("AA:AA").Select
Selection.ClearContents
Range("K2").Select

 End Sub

---

检测相同的数据范围相当容易。标准方法是使用@xQbert的方法，即将值连接在一起。在VBA中，这很容易，因为有一个

Join

函数，它将获取一个数组并将其转换为字符串。这在Excel公式中更难（或者说更乏味），因为

串联

要求每个项都是单独的

使用

Join

可以为连接在一起的所有单元格创建一个“ID”。如果将其与

字典结合使用

，则可以在其中存储所需的行颜色，然后将该颜色应用于该行

这里唯一困难的部分是决定你想要使用哪种颜色。我现在只是在做随机数，这通常会使一些东西是可用的。如果您知道所需的总颜色数，则可以将其扩展为使用颜色列表

Code要求您向Microsoft脚本运行时添加引用（Tools->References），以使词典正常工作

Sub ColorForUnique()

    'must add a reference to Microsoft Scripting Runtime
    Dim dict As New Scripting.Dictionary

    'build range from block of data
    'only check columns F:K for matches
    Dim rng_match As Range
    Set rng_match = Intersect( _
        Range("B2:M8"), _
        Range("F:K"))

    Dim rng_row As Range
    For Each rng_row In rng_match.Rows

        Dim id As String
        id = Join(Application.Transpose(Application.Transpose(rng_row.Value)), "")

        If Not dict.Exists(id) Then
            dict.Add id, RGB(Application.RandBetween(0, 255), Application.RandBetween(0, 255), Application.RandBetween(0, 255))
        End If

        rng_row.EntireRow.Interior.Color = dict(id)
    Next rng_row
End Sub

代码限制/注释

• 我正在使用双

  转置

  强制

  值

  成为1D值数组。这以及对循环使用

  .Rows

  意味着这只适用于连续的数据块。如果所有列不在一起，则可以构建不同的循环

结果图片对于某些任意数据，显示所需的颜色。我使用您的列，这样您就可以运行此代码

以前

之后

编辑以允许颜色选择：此代码可以轻松扩展以允许颜色选择，而不是随机着色。

字典

提供了一个很好的内置计数器，用于计算使用

字典.Count的ID数量。您可以将其用作选择颜色的索引。您也可以使用整数作为要使用的颜色，尽管这些颜色并不理想

修改颜色添加步骤以使用函数，而不仅仅是随机数：

If Not dict.Exists(id) Then
    dict.Add id, GetColor(dict.Count + 1)
End If

然后定义
GetColor
函数以提供所需的任何颜色。如果您愿意，还可以使用
ColorIndex
值填充此字段。如果要更改颜色，请稍后使用
Interior.ColorIndex
。下面是该函数的两个选项。一个执行随机颜色，另一个从ColorBrewer Pallete返回颜色

'random colors always
Function GetColor(index As Integer) As Long

    GetColor = RGB(Application.RandBetween(0, 255), _
        Application.RandBetween(0, 255), Application.RandBetween(0, 255))

End Function

'first 10 colors from the ColorBrewer palette
Function GetColor(index As Integer) As Long

    Dim colors(1 To 10) As Long

    colors(6) = RGB(166, 206, 227)
    colors(1) = RGB(31, 120, 180)
    colors(7) = RGB(178, 223, 138)
    colors(3) = RGB(51, 160, 44)
    colors(8) = RGB(251, 154, 153)
    colors(2) = RGB(227, 26, 28)
    colors(9) = RGB(253, 191, 111)
    colors(4) = RGB(255, 127, 0)
    colors(10) = RGB(202, 178, 214)
    colors(5) = RGB(106, 61, 154)

    'protect against bad index
    If index > UBound(colors) Or index < LBound(colors) Then
        GetColor = RGB(255, 255, 255)
    Else
        GetColor = colors(index)
    End If

End Function

“始终使用随机颜色
函数GetColor（索引为整数）的长度为
GetColor=RGB（Application.randthever（0255）_
Application.randtween（0255），Application.randtween（0255））
端函数
“ColorBrewer调色板的前10种颜色
函数GetColor（索引为整数）的长度为
暗淡的颜色（1到10）与长度相同
颜色（6）=RGB（166、206、227）
颜色（1）=RGB（31、120、180）
颜色（7）=RGB（178223138）
颜色（3）=RGB（51、160、44）
颜色（8）=RGB（251、154、153）
颜色（2）=RGB（227,26,28）
颜色（9）=RGB（253191111）
颜色（4）=RGB（255、127、0）
颜色（10）=RGB（202178214）
颜色（5）=RGB（106、61、154）
"防范不良指标",
如果索引>UBound（颜色）或索引
添加一个新列，将所有值连接在一起，您必须在一个新列中签入这些值，然后将其用作单个列。xQbert这是个好主意！现在我需要尝试找出如何比较结果并突出显示不同颜色的副本。很好的想法新列在iMachancea中不是必需的-就像VBA一样，我对条件格式的工作非常有限。这听起来像是可以很容易地通过条件格式实现的东西？也许不容易，我会玩一玩。这太神奇了！特别是代码有多短。事实上，我能够将我自己的代码与弗兰肯斯坦整合在一起，除了它不会给不重复的行赋予它们自己的颜色之外，这些代码似乎工作得很好。改变你衣服上的颜色选择方式容易吗？在我的文章中，它引用了颜色索引（我添加了代码作为答案，希望得到您的反馈），关于颜色选择的一些想法，请参见编辑。