Необходимо в экселе делать обратную транслитерацию. Макрос за основу взял этот http://www.planetaexcel.ru/techniques/7/32/ и поменял местами англ и рус буквы. Но есть известная проблема, с сочетаниями буквами sh, ch и так далее. Поэтому есть смысл в макросе сначала проверить сочетания букв, а потом по отдельности буквы. Я в макросах не силен, только изучаю. Вопрос : замена в тексте сначала сочетаний, а потом уже отдельных букв. Помогите поправить мой макрос. Спасибо!
Function Transliterr (Txt As String) As String
Function Transliterr (Txt As String) As String
- Dim Eng As Variant
- Eng = Array("shh", "aa", "yy", "kh", "ch", "sh", "ts", "ya", "yu", "jo", "zh", "SHH", "AA", "YY", "KH", "CH", "SH", "TS", "YA", "YU", _
- "JO", "ZH", "'", "a", "b", "v", "g", "d", "e", "z", "i", "j", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "'", "A", "B", "V", _
- "G", "D", "E", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F")
-
- 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
-
- Transliterr = outstr
- End Function