基于相邻单元格中的字符串突出显示Excel中单元格中的字符串

时间:2017-05-23 12:58:58

标签: excel vba excel-vba string-matching conditional-formatting

我有一种情况需要对单元格中的一些逗号分隔的字符串应用一些条件格式,具体取决于它们的[A-Z]前缀是否与相邻单元格中字符串的[A-Z]前缀不匹配。我正在使用的数据集的一个示例如下:

  comma_separated_list           string_to_match
1 BND170015,BND170027,BNL160006  BND12000512
2 BOL030017,ISS160014,ISS160015  ISS03000325
3 BIL160182,BIL160185,BIL160186  BIL13001102
4 SRD160238,SRD160239,SRD160240  SRD12000987

例如,在第一行中,条件格式应仅应用于“comma_separated_list”列中的BNL160006。这是因为其字母前缀BNL与BND12000512的前缀不匹配(在“string_to_match”列中)。在第2行中,条件格式应仅应用于BOL030017(因为它与ISS03000325不匹配)。等等。

首先,我首先将一些内容放在一起,突出显示右侧列中左侧列中的任何前缀。然而,这并不是我所需要的;它只突出显示前缀(不是整个字符串),我还希望它只突出显示不匹配的字符串。

Sub ColourText()
    Dim xStr As String
    Dim xRg As Range
    Dim xCell As Range
    Dim xChar As String
    Dim I As Long
    Dim J As Long

    Set xRg = Range("B2:C10000")
    If xRg Is Nothing Then Exit Sub
    For I = 0 To xRg.Rows.Count - 1
        xStr = Left(xRg.Range("B1").Offset(I, 0).Value, 3)
        With xRg.Range("A1").Offset(I, 0)
            .Font.ColorIndex = 1
            For J = 1 To Len(.Text)
                If Mid(.Text, J, Len(xStr)) = xStr Then .Characters(J, Len(xStr)).Font.ColorIndex = 3
            Next
        End With
    Next I
End Sub

我也考虑过通过公式完成所有操作,但我看不到这样做的方法并同时应用条件格式。所以我现在有点卡住了。非常感谢一些帮助。

1 个答案:

答案 0 :(得分:0)

尝试这样的事情......

代码假定字符串放在A列中,要匹配的字符串放在B列中。根据您的要求修改它。

Sub HighlightUnMatchedText()
Dim lr As Long, i As Long, Pos As Long
Dim Rng As Range, Cell As Range
Dim str() As String, critStr As String
Application.ScreenUpdating = False
lr = ActiveSheet.UsedRange.Rows.Count
Set Rng = Range("A2:A" & lr)
Rng.Font.ColorIndex = xlAutomatic
For Each Cell In Rng
    If Cell <> "" And Cell.Offset(0, 1) <> "" Then
        critStr = Left(Cell.Offset(0, 1), 3)
        str() = Split(Cell.Value, ",")
        For i = 0 To UBound(str)
            If Left(VBA.Trim(str(i)), 3) <> critStr Then
                Pos = InStr(Cell.Value, str(i))
                Cell.Characters(Pos, Len(str(i))).Font.Color = vbRed
            End If
        Next i
    End If
Next Cell
Application.ScreenUpdating = True
End Sub