如何编写VB脚本以在所有单元格中查找多个字符串并突出显示每一行？

Question

如何更改以下代码行以在工作表中查找字符串，如果字符串包含在单元格中，则突出显示行？例如，搜索字符串是“SV-32346r1”，单元格内容是“该文档包含Cali中标识符为SV-32346r1的汽车列表”。这一行应该突出显示。以下代码仅搜索完全匹配。

If InStr(strConcatList, cell.Value) > 0 Then       'InStr returns 0 if the string isn't found
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
End If

完整代码（感谢艾肯）：

Public Sub HighlightListedValues()
Dim strConcatList As String
Dim cell As Range

'Creates a string concatenating your list of strings, separated by |s
'e.g. "item1|item2|item3|item4|"
For Each cell In Sheets("List").Range("A1:A40")
strConcatList = strConcatList & cell.Value & "|"
Next cell

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("Gap Analysis").Range("E:E"), Sheets("Gap Analysis").UsedRange)
If InStr(strConcatList, cell.Value) > 0 Then       'InStr returns 0 if the string isn't found
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
End If
Next cell
End Sub

Answer 1

您需要针对单元格测试列表中的每个元素，而不是针对列表测试每个单元格。一种方法是使用正则表达式。事实证明，正则表达式中的管道分隔列表执行这种匹配。在下面的代码中，更改＆＃34; Sheet1＆＃34;到＆＃34;列表＆＃34 ;;和＆＃34; Sheet2＆＃34;到＆＃34;差距分析＆＃34;。请注意，我改变了StrConcat的组合方式，因此列表的开头或结尾没有管道，也没有＆＃34;空＆＃34;项目

Option Explicit
Public Sub HighlightListedValues()
Dim strConcatList As String
Dim cell As Range
Dim RE As Object

'Creates a string concatenating your list of strings, separated by |s
'e.g. "item1|item2|item3|item4|"
For Each cell In Sheets("Sheet1").Range("A1:A40")
    If cell.Value <> "" Then strConcatList = strConcatList & "|" & cell.Value
Next cell
strConcatList = Mid(strConcatList, 2)

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True
    .Pattern = strConcatList
End With

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("sheet2").Range("E:E"), Sheets("sheet2").UsedRange)
If RE.test(cell.Value) = True Then
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
Else
    cell.EntireRow.Interior.Color = xlNone
End If
Next cell
End Sub

如果您不想使用正则表达式，那么可以使用＆＃34; native＆＃34; VBA：

Option Explicit
Public Sub HighlightListedValues()
Dim strConcatList() As String
Dim cell As Range
Dim I As Long

'Creates an arrary of your list of strings
With Worksheets("Sheet1").Range("A1:A40")
    ReDim strConcatList(1 To WorksheetFunction.CountA(.Value))
    For Each cell In .Cells
        If cell.Value <> "" Then
            I = I + 1
            strConcatList(I) = cell.Value
        End If
    Next cell
End With

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("sheet2").Range("E:E"), Sheets("sheet2").UsedRange)
    For I = 1 To UBound(strConcatList)
        With cell.EntireRow.Interior
        If InStr(1, cell.Value, strConcatList(I), vbTextCompare) > 0 Then
            .Color = vbRed
            Exit For
        Else
            .Color = xlNone
        End If
        End With
    Next I
Next cell
End Sub

Answer 2

如果您对非VBA解决方案感兴趣，请参阅如何使用条件格式设置。假设您的数据位于A列，而您的代码列表位于C2：C7中，则可以使用此条件格式公式：

=SUM(COUNTIF($A4,"*" & $C$2:$C$7 & "*"))

像这样设置：

请注意，这允许您使用多个代码，我猜这可能是您使用VBA的原因。