Function СОПОСТАВЛЕНИЕ(txt1 As String, txt2 As String)
    Dim arr1, arr2, str1$, str2$, i&
    Set dic = CreateObject("Scripting.Dictionary")
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Global = True
    RegExp.IgnoreCase = True
    str1 = Replace_symbols(Trim(txt1))
    arr1 = Split(str1, " ")
    For i = LBound(arr1) To UBound(arr1)
        If Not dic.exists(arr1(i)) Then dic.Add CStr(arr1(i)), CStr(arr1(i))
    Next
    str1 = " " & Join(dic.Items, " | ") & " "
    dic.RemoveAll
    str2 = Replace_symbols(Trim(txt2))
    arr2 = Split(str2, " ")
    For i = LBound(arr2) To UBound(arr2)
        If Not dic.exists(arr2(i)) Then dic.Add CStr(arr2(i)), CStr(arr2(i))
    Next
    str2 = " " & Join(dic.Items, "  ") & " "
    dic.RemoveAll
    RegExp.Pattern = str1
    For i = 0 To RegExp.Execute(str2).Count - 1
        dic.Add Trim(CStr(RegExp.Execute(str2).Item(i).Value)), Trim(CStr(RegExp.Execute(str2).Item(i).Value))
    Next
    СОПОСТАВЛЕНИЕ = Join(dic.Items, "; ")
End Function

Function Replace_symbols(ByVal txt As String) As String
    Dim st$, i&
    st$ = ",.\/<>?^*:|`'"""
    For i& = 1 To Len(st$)
        txt = Replace(txt, Mid(st$, i&, 1), " ")
    Next i&
    Do
        txt = Replace(txt, "  ", " ")
    Loop While InStr(txt, "  ") > 0
    Replace_symbols = Trim(txt)
End Function