Словосочитания из словаря заменить на соответствующие им сокращения

Function RowLingvo(txt As String) As String
Dim i As Integer, str As String, str2 As String, m As String
For i = 1 To Len(txt) ' пробегаем всю фразу по буквам
    m = Mid(txt, i, 1) ' берем очередную букву
    If m >= "А" And m <= "я" Then ' проверяем ее на кириллицу
        str2 = "" ' если кирилица то обнуляем слово
        Do ' запускаем цикл для определения очередного слова
            str2 = str2 & m 'приклеиваем к слову очередную буку
            i = i + 1 'накручиваем счетчик
            m = Mid(txt, i, 1) 'берем очередную букву
        Loop While m >= "А" And m <= "я" And i <= Len(txt) ' повторять пока слово не закончилось и не закончилась фраза
        i = i - 1 ' сбрасываем счетчик на 1
        
        If IsError(Application.VLookup(str2, Range("lingvo"), 2, 0)) Then ' проверяем слово на наличие в словаре
            str = str & str2 ' если слова нет, то не переводим
        Else
            str = str & Application.VLookup(str2, Range("lingvo"), 2, 0) ' переводим текущее слово
        End If
        
    Else
        str = str & m ' если символ не кириллица, то оставляем его без изминений
    End If
Next i ' следующая буква
RowLingvo = str ' возвращаем перевод
End Function