时间戳

首页 > 解决方案 > 突出显示颜色在同一行中匹配的值

excel - 突出显示颜色在同一行中匹配的值

问题描述

我有一个 Excel 表，其中 B2:AF7 中的值用三种不同的颜色突出显示。我使用 VBA 代码来突出显示值（本文未提及代码）。

我的问题是：
如何用单独的颜色突出显示，其中三种颜色在同一行匹配。（参考见图片：第 11、14、15 和第 4 行与三种不同的颜色匹配，我想用不同的颜色突出这些值）

我写了以下代码，但它不起作用。

感谢您宝贵的时间。

Dim r as range
Dim i as integer
set r = range("b2:af7")

For i = 2 To 31
    if r.Interior.ColorIndex = 3 and  r.Interior.ColorIndex = 4 and    r.Interior.ColorIndex = 6 then
        msgbox r.address
        r.Interior.ColorIndex = 37
    else
        msgbox "Row not found"
    end if
Next i

在此处输入图像描述

标签： excelvba

解决方案

使用正则表达式的方法

如果您转换数据范围的颜色索引……</p>

在此处输入图像描述

… 成一系列颜色索引，如下所示：

0000000003030600000000000000000
0006000000000000000000000000000
0400300000004000460000000000000
0000003000300460000046000000000
0000003330000000000000000000000

您可以使用正则表达式来查找颜色模式346、364、436、463和。634643

我使用以下模式忽略两者之间的零：

3{1}0*4{1}0*6{1}|3{1}0*6{1}0*4{1}|4{1}0*3{1}0*6{1}|4{1}0*6{1}0*3{1}|6{1}0*3{1}0*4{1}|6{1}0*4{1}0*3{1}

以匹配作为结果，您将得到Match.FirstIndex代表模式的起始列和Match.Length代表匹配长度的列。

所以……</p> 

DataRange.Cells(iRow, Match.FirstIndex + 1).Resize(ColumnSize:=Match.Length)

…您检索与模式匹配的当前行的范围。

这是一个例子

Option Explicit

Public Sub FindColorPattern()
    Dim DataRange As Range 'define data range
    Set DataRange = ThisWorkbook.Worksheets("Sheet1").Range("B2:AF7")
    
    Dim iRow As Long
    For iRow = 1 To DataRange.Rows.Count 'loop row wise
        'read color indices into an array
        Dim PatternArray As Variant
        ReDim PatternArray(1 To DataRange.Columns.Count)
        Dim iCol As Long
        For iCol = 1 To DataRange.Columns.Count
            PatternArray(iCol) = DataRange(iRow, iCol).Interior.ColorIndex
            If PatternArray(iCol) <> 3 And PatternArray(iCol) <> 4 And PatternArray(iCol) <> 6 Then PatternArray(iCol) = 0
        Next iCol
        
        'find pattern
        Dim Matches As Object
        Set Matches = MatchPattern(Join(PatternArray, vbNullString))
        
        'mark found pattern in data range
        If Not Matches Is Nothing Then
            Dim Match As Object
            For Each Match In Matches
                With DataRange.Cells(iRow, Match.FirstIndex + 1).Resize(ColumnSize:=Match.Length)
                    'draw a border around the match
                    .Borders(xlEdgeBottom).LineStyle = xlSolid
                    .Borders(xlEdgeBottom).ColorIndex = 9
                    .Borders(xlEdgeTop).LineStyle = xlSolid
                    .Borders(xlEdgeTop).ColorIndex = 9
                    .Borders(xlEdgeLeft).LineStyle = xlSolid
                    .Borders(xlEdgeLeft).ColorIndex = 9
                    .Borders(xlEdgeRight).LineStyle = xlSolid
                    .Borders(xlEdgeRight).ColorIndex = 9
                End With
            Next Match
        End If
    Next iRow
End Sub


Function MatchPattern(TextToSearch As String) As Object
    Dim RegEx As Object, Matches As Object

    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .MultiLine = True
        .Global = True
        .IgnoreCase = False
        .Pattern = "3{1}0*4{1}0*6{1}|3{1}0*6{1}0*4{1}|4{1}0*3{1}0*6{1}|4{1}0*6{1}0*3{1}|6{1}0*3{1}0*4{1}|6{1}0*4{1}0*3{1}"
    End With

    Set Matches = RegEx.Execute(TextToSearch)
    If Matches.Count > 0 Then
        Set MatchPattern = Matches
    Else
        Set MatchPattern = Nothing
    End If
End Function

推荐阅读