Добрый день!
Немного пришлось изменить функцию , все работает но не пойму почему вместо С (лат.) получается М (кир.) и дальше все со сдвигом.
Или может есть другой вариант решения такого вопроса.
Помогите новичку. Спасибо.
Немного пришлось изменить функцию , все работает но не пойму почему вместо С (лат.) получается М (кир.) и дальше все со сдвигом.
Или может есть другой вариант решения такого вопроса.
Помогите новичку. Спасибо.
Код |
---|
Function Translit(Txt As String) As String Dim Eng As Variant Eng = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", _ "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", _ "x", "c", "v", "b", "n", "m", ",", ".", "Q", "W", "E", "R", "T", _ "Y", "U", "I", "O", "P", "[", "]", "A", "S", "D", "F", "G", "H", _ "J", "K", "L", ";", "'", "Z", "X", "C", "V", "B", "N", "M", ",", "." Dim Rus As Variant Rus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", _ "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", _ "м", "и", "т", "ь", "б", "ю", "Й", "Ц", "У", "К", "Е", "Н", "Г", _ "Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", _ "Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Б", "Ю" For I = 1 To Len(Txt) с = Mid(Txt, I, 1) flag = 0 For J = 0 To 64 If Eng(J) = с Then outchr = Rus(J) flag = 1 Exit For End If Next J If flag Then outstr = outstr & outchr Else outstr = outstr & с Next I Translit = outstr End Function |