如果单元格包含多个文本字符串的部分匹配，则应用条件格式 VBA-解网

问：

目前能够对 H：H 等列范围进行 VBA 搜索，如果 H：H 中的任何单元格与单元格 A1（可能是“LTD”）部分匹配，则应用条件格式。但是，我正在努力寻找一种代码，允许我将部分匹配项扩展到针对 H：H 的单元格 B1“CO”和 C1“LLC”。理想情况下，我想用一个代码查看针对 H：H 的多个单元格，而不必多次运行代码来获取条件格式。

VBA代码如下：

Private Sub CommandButton1_Click()
 
Dim Partial_Text As String
Dim myrange As Range

Partial_Text = Worksheets("Workbook").Cells(1, 1).Value
Set myrange = Worksheets("Workbook").Range("H:H")
myrange.Interior.Pattern = xlNone

For Each cell In myrange

    If InStr(LCase(cell.Value), LCase(Partial_Text)) <> 0 Then cell.Interior.ColorIndex = 4
 
Next

End Sub

有没有人能够帮助我并改进这一点？

谢谢！

尝试了上面的代码，并希望有一个解决方案，允许我运行一次VBA代码，而不是多次。我运行 VBA 代码的原因是因为在标准 excel 公式中，通配符不会拾取部分匹配项，但 VBA 会。

Excel VBA 筛选器匹配 Instr

Private Sub CommandButton1_Click()
    Dim Partial_Text As Variant
    Dim myrange As Range
    Dim keywords As Variant
    Dim keyword As Variant

    ' Define the partial match keywords in an array
    keywords = Array("LTD", "CO", "LLC")

    Set myrange = Worksheets("Workbook").Range("H:H")
    myrange.Interior.Pattern = xlNone

    For Each cell In myrange
        For Each keyword In keywords
            Partial_Text = Worksheets("Workbook").Cells(1, keyword).Value
            If InStr(LCase(cell.Value), LCase(Partial_Text)) <> 0 Then
                cell.Interior.ColorIndex = 4
                Exit For ' Exit the loop if a match is found for this keyword
            End If
        Next keyword
    Next cell
End Sub

我希望它有效！:)

1赞 Tim Williams 8/10/2023 #2

也许是这样的：

Private Sub CommandButton1_Click()
 
    Dim cell As Range, ws As Worksheet
    Dim myrange As Range, v, arrTerms As Variant, r As Long
    
    Set ws = Worksheets("Workbook")
    Set myrange = ws.Range("H1:H" & ws.Cells(Rows.Count, "H").End(xlUp).row)
    myrange.Interior.Pattern = xlNone
    
    arrTerms = ws.Range("A1:C1").Value 'for example: all search terms
    
    For Each cell In myrange.Cells
        v = cell.Value
        If Len(v) > 0 Then
            For r = 1 To UBound(arrTerms, 1) 'loop array of search terms
                If InStr(1, v, arrTerms(r, 1), vbTextCompare) <> 0 Then
                    cell.Interior.ColorIndex = 4
                    Exit For 'no need to check further
                End If
            Next r
        End If  'anything to check
    Next        'cell to check

End Sub

上一个：Google 表格 - 数组中的多个条件匹配

下一个：Excel VBA，从不活动工作表中获取范围

如果单元格包含多个文本字符串的部分匹配，则应用条件格式 VBA

If cell contains partial match of multiple text strings, then apply conditional formatting VBA

评论