Транслитерация строки

По материалам: http://excelvba.ru/code/translit

Public Function Translit(ByVal txt As String) As String
'Транслитерация с учётом регистра символов 
Dim txtRussian As String
Dim arrTranslit As Variant
Dim iCount As Integer
    txtRussian = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
    arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "y", "k", "l", "m", "n", "o", _
    "p", "r", "s", "t", "u", "f", "kh", "ts", "tch", "sh", "sch", "", "y", "", "e", "yu", "ya")
    For iCount = 1 To 33
        'Строчные буквы
        txt = Replace(txt, Mid(txtRussian, iCount, 1), arrTranslit(iCount))
        'прописные
        txt = Replace(txt, UCase(Mid(txtRussian, iCount, 1)), UCase(arrTranslit(iCount)))
    Next
    Translit = txt
End Function