Function Translit(x As String) As String
cyr = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
lat = 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", "ch", _
"sh", "sch", "y", "y", "", "e", "yu", "ya")
For i = 1 To 33
x = Replace(x, Mid(cyr, i, 1), lat(i), , , vbBinaryCompare)
x = Replace(x, UCase(Mid(cyr, i, 1)), StrConv(lat(i), vbProperCase), , , vbBinaryCompare)
Next
Translit = x
End Function