Function Translit(Txt As String) As String
   Application.Volatile
 
    Dim Rus As Variant
    Rus = Array("ŕ", "á", "â", "ă", "´", "ä", "ĺ", "ş", "ć", "ç", "č", "ł", _
    "ż", "é", "ę", "ë", "ě", "í", "î", "ď", "đ", "ń", "ň", "ó", "ô", "ő", _
    "ö", "÷", "ř", "ů", "ü", "ţ", "˙", "Ŕ", "Á", "Â", "Ă", "Ą", "Ä", "Ĺ", _
    "Ş", "Ć", "Ç", "Č", "˛", "Ż", "É", "Ę", "Ë", "Ě", "Í", "Î", _
    "Ď", "Đ", "Ń", "Ň", "Ó", "Ô", "Ő", "Ö", "×", "Ř", "Ů", "Ü", "Ţ", "ß", "'", "-", " ")
 
    Dim Eng As Variant
    Eng = Array("A", "B", "V", "H", "G", "D", "E", "IE", "ZH", "Z", "Y", "I", "I", "I", _
    "K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F", "KH", "TS", "CH", _
    "SH", "SHCH", "", "IU", "IA", "A", "B", "V", "H", "G", "D", _
    "E", "YE", "ZH", "Z", "Y", "I", "I", "I", "K", "L", "M", "N", "O", "P", "R", _
    "S", "T", "U", "F", "KH", "TS", "CH", "SH", "SHCH", "", "YU", "YA", "", "-", " ")
     
    For I = 1 To Len(Txt)
        c = Mid(Txt, I, 1)
     
        flag = 0
        For J = 0 To 68
            If Rus(J) = c Then
                outchr = Eng(J)
                flag = 1
                Exit For
            End If
        Next J
        If flag Then outstr = outstr & outchr Else outstr = outstr & c
    Next I
     
    Translit = outstr  
End Function