突出显示基于某些单元格匹配的行

时间:2015-06-04 14:10:12

标签: excel

如果我在这里期待太多,请原谅我,但我认为必须有比我一直做得更快的方式。

所以我有电子表格,我必须根据某些列中的条件对行进行排序和匹配(在此示例中,列FGHIJK进行比较)并突出显示匹配行的颜色,使其与其他行不同,并继续此操作,直到每一行都着色为止。下面是开始数据的图像和我需要的理想结束。

我的问题来自于不知道如何告诉它并比较适当的列。如果我告诉它只看一列,我可以让它工作。例如,如果我所看到的只是列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

http://i.imgur.com/Nte31Bn.jpgScreentshot

EDIT! 所以我已经能够根据一些反馈和想法拼凑出一个工作代码。这不是最漂亮的,但是用户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

1 个答案:

答案 0 :(得分:1)

检测相同的数据范围相当容易。标准方法是使用@xQbert的方法将值连接在一起。在VBA中,这很容易,因为有一个Join函数,它将获取一个数组并将其转换为字符串。这在Excel公式中更难(或实际上更乏味),因为CONCATENATE需要单独的每个项目。

使用Join您可以创建一个" ID"对于所有连接在一起的单元格的行。如果将其与Dictionary结合使用,则可以在其中存储所需的行颜色,然后将该颜色应用于该行。

这里唯一困难的部分是决定你想要使用哪种颜色。我目前只是制作随机数字,通常会产生一些可用的东西。如果您知道需要多少总颜色,可以将其扩展为使用颜色列表。

代码要求您向Tools->References添加引用(Microsoft Scripting Runtime),以使Dictionary生效。

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

代码限制/注释

  • 我正在使用双Transpose强制.Value成为一维值数组。这个以及.Rows对循环的使用意味着这仅适用于连续的数据块。如果所有列都不在一起,您可以构建一个不同的循环。
某些任意数据的

结果图片显示所需的颜色。我使用您的列,以便您只能运行此代码。

之前

before

after

编辑以允许颜色选择:此代码可以轻松扩展,以允许颜色选择而不是随机着色。 Dictionary使用Dictionary.Count为使用的ID提供了一个很好的内置计数器。您可以将其用作选择颜色的索引。您也可以使用整数作为颜色使用,尽管这些颜色并不理想。

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

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

然后定义GetColor函数以提供所需的任何颜色。如果您愿意,也可以使用ColorIndex值填写此值。如果您这样做,请稍后使用Interior.ColorIndex更改颜色。以下是该功能的两个选项。一个是随机颜色,另一个是从ColorBrewer调色板中返回颜色。

'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