vba - 如何编写 VB 脚本以在所有单元格中查找多个关键字并突出显示每个关键字？

Question

我目前有一个关键字列表（例如 CFO、CTO、临时经理等），我希望将一个宏分配给一个按钮，该按钮可以搜索表 1 的 E 列中包含这些关键字的所有单元格，然后返回结果以及突出显示单元格中的关键字。

• 每个关键字都位于工作表 2 的 A 列中的单独单元格中。
• 如果列表中有一个关键字，它会搜索一个，如果有更多，它会搜索组合。

这是用于说明我上面描述的屏​​幕截图

我在 Internet 上找到了一些建议使用 AutoFilter，但我只能使用它来搜索一个关键字。这是我尝试过的：

Sub EmailFilter()

Application.ScreenUpdating = False

With Worksheets("Sheet1").Columns("E:E")
        .AutoFilter Field:=1, Criteria1:= _
    "=*" & Worksheets("Sheet2").Range("A2:A10") & "*", Operator:=xlAnd
    End With

Application.ScreenUpdating = True

End Sub

提前致谢。

Answer 1

下面的代码将用相同的颜色为所有匹配着色（我选择了蓝色）。您可以在模块中编写此宏，然后创建表单控件按钮并将宏分配给按钮。

Sub macro()
Dim a As Integer, x As String, mystring As String
a = 2
Sheets("Sheet2").Activate
Cells(a, 1).Activate
Do While ActiveCell.Value <> ""
    x = ActiveCell.Value
    p = Len(x)
    Application.GoTo Sheet1.Range("E2")
    Do While ActiveCell.Value <> ""
        mystring = ActiveCell.Value
        If InStr(mystring, x) > 0 Then
            Position = InStr(1, mystring, x)
            If Position > 0 Then
                ActiveCell.Characters(Position, p).Font.Color = RGB(255, 0, 0)
            End If
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
    a = a + 1
    Application.GoTo Sheet2.Cells(a, 1)
Loop
End Sub

让我知道您是否有任何其他特定要求，以便可以更改代码。我希望这有帮助。