Как написать скрипт 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 

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