vba функция по переводу в транслит.vba

vba-Функция по переводу в транслит.vba

Public Function textTranslite(text As String) As String
    Dim dic As New dictionary
    dic.Add "А", "A"
    dic.Add "а", "a"
    dic.Add "Б", "B"
    dic.Add "б", "b"
    dic.Add "В", "V"
    dic.Add "в", "v"
    dic.Add "Г", "G"
    dic.Add "г", "g"
    dic.Add "Д", "D"
    dic.Add "д", "d"
    dic.Add "Е", "E"
    dic.Add "е", "e"
    dic.Add "Ё", "YO"
    dic.Add "ё", "yo"
    dic.Add "Ж", "ZH"
    dic.Add "ж", "zh"
    dic.Add "З", "Z"
    dic.Add "з", "z"
    dic.Add "И", "I"
    dic.Add "и", "i"
    dic.Add "Й", "Y"
    dic.Add "й", "y"
    dic.Add "К", "K"
    dic.Add "к", "k"
    dic.Add "Л", "L"
    dic.Add "л", "l"
    dic.Add "М", "M"
    dic.Add "м", "m"
    dic.Add "Н", "N"
    dic.Add "н", "n"
    dic.Add "О", "O"
    dic.Add "о", "o"
    dic.Add "П", "P"
    dic.Add "п", "p"
    dic.Add "Р", "R"
    dic.Add "р", "r"
    dic.Add "С", "S"
    dic.Add "с", "s"
    dic.Add "Т", "T"
    dic.Add "т", "t"
    dic.Add "У", "U"
    dic.Add "у", "u"
    dic.Add "Ф", "F"
    dic.Add "ф", "f"
    dic.Add "Х", "KH"
    dic.Add "х", "kh"
    dic.Add "Ц", "TS"
    dic.Add "ц", "ts"
    dic.Add "Ч", "CH"
    dic.Add "ч", "ch"
    dic.Add "Ш", "SH"
    dic.Add "ш", "sh"
    dic.Add "Щ", "SHCH"
    dic.Add "щ", "shch"
    dic.Add "ъ", ""
    dic.Add "ы", "y"
    dic.Add "ь", ""
    dic.Add "Э", "E"
    dic.Add "э", "e"
    dic.Add "Ю", "YU"
    dic.Add "ю", "yu"
    dic.Add "Я", "YA"
    dic.Add "я", "ya"
    dic.Add " ", "_"


    Dim resultText As String
    Dim selectChar As String

    For i = 1 To Len(text)
        selectChar = Mid(text, i, 1)
        If (dic.Exists(selectChar)) Then
            Dim replaceChar As String
            replaceChar = dic.Item(selectChar)
            resultText = resultText & replaceChar
        Else
            resultText = resultText & selectChar
        End If
    Next i

    textTranslite = resultText
End Function