Как написать скрипт VB, чтобы найти несколько ключевых слов во всех ячейках и выделить каждое ключевое слово?

Question

В настоящее время у меня есть список ключевых слов (например, CFO, CTO, временный менеджер и т. Д.), И я хочу иметь макрос, назначенный кнопке, которая может искать все ячейки в столбце E на листе 1, которые содержат эти ключевые слова, а затем возвращают результат, а также выделите ключевое слово в ячейке.

• Каждое ключевое слово находится в отдельной ячейке в столбце А листа 2.
• Если в списке есть одно ключевое слово, оно будет искать одно, но если их будет больше, оно будет искать комбинацию.

Вот скриншот, чтобы проиллюстрировать то, что я описал выше

Я нашел что-то в Интернете с предложением использовать автофильтр, но я могу использовать его только для поиска по одному ключевому слову. Вот что я попробовал:

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

Дайте мне знать, если у вас есть какие-то особые требования, чтобы код мог быть изменен. Надеюсь, это поможет.