Public Sub findPattern()
Dim regEx As Object, oDict As Object
Dim s As String, s1 As String
Dim rowLast As Long
Dim arrWords, unoWords, regRez
Const strRaz = "||"

Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1
With ActiveSheet
    rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To rowLast
        If Not oDict.exists(.Cells(i, 1).Value) Then _
        oDict.Add .Cells(i, 1).Value, i
    Next i
    
    arrWords = oDict.keys
    For Each unoWords In arrWords
        s = s & unoWords & strRaz
    Next
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = true'Нужны все совпадения
        .IgnoreCase = False 'Регистр 
        s1 = "(" & ActiveSheet.Cells(9, 4).Text & ")" & "+?(" & strRaz & ")"
        
        .Pattern = s1 'Регулярка
     ''.Pattern = strRaz
    End With
    If regEx.Test(s) Then
        Set regRez = regEx.Execute(s)
    End If
    s = ""
    For Each unoWords In regRez
        s = s & unoWords.submatches(0) & " " & oDict(unoWords.submatches(0)) & strRaz
    Next
End With
End Sub