Function Translit(ByVal txt As String) As String
iRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
iTranslit = Array("", "a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "jj", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "c", "ch", _
"sh", "zch", "''", "'y", "'", "eh", "ju", "ja")
For iCount% = 1 To 33
txt = Replace(txt, Mid(iRussian$, iCount%, 1), iTranslit(iCount%), , , vbTextCompare)
Next
Translit$ = txt
End Function
Sub ПримерИспользованияФункцииTranslit()
txt = "проверка работы транслита"
newtxt = Translit(txt) ' результат = строка "proverka rabot'y translita"
MsgBox "Строка """ & txt & """" & vbNewLine & "преобразована в строку """ _
& newtxt & """", vbInformation, "Результат обработки"
End Sub
Надстройку для транслитерации выделенного диапазона ячеек,
а также расширенную версию функции транслитерации, можно скачать в этой статье
(добавлено в связи с просьбой выполнить обратную транслитерацию)
К сожалению, процесс обратной транслитерации весьма затруднён (я бы даже сказал, что в общем случае невозможно сделать такую функцию, которая преобразовывала бы строку после транслитерации к исходному виду).
Попытаюсь объяснить, почему так происходит:
Допустим, в качестве исходной строки у нас будет текст "щзч схш жзх"
Sub ПримерИспользованияФункцииTranslit()
txt = "щзч схш жзх"
newtxt = Translit(txt)
Debug.Print newtxt ' результат = строка "zchzch shsh zhzh"
MsgBox "Строка """ & txt & """" & vbNewLine & "преобразована в строку """ _
& newtxt & """", vbInformation, "Результат обработки"
End Sub
И что же мы видим на выходе?
А вот что: "zchzch shsh zhzh"
Достаточно похожие сочетания букв, не правда ли?
И как теперь макросу определить, что означает сочетание "zch sh zh" - "щ сх ж" или "зч ш ж"?
Или, может, "зч сх зх"? Все варианты для макроса ведь равнозначны...
А сочетание "zhzh" следует перевести как "зхзх" или как "жж"?
То же самое касается некоторых других буквосочетаний.
Специально проверил транслитерацию подобных сочетаний на популярном сервисе http://www.translit.ru/
Результат - при обратном переводе на русский исходная строка изменилась: схш жзх --> shsh zhzh --> шш жж
Вывод: учитывая возможное количество неопределённостей, проще обратную транслитерацию выполнять вручную.
Другой вариант функции:
Function Translit(ByVal txt As String) As String ' с учётом регистра символов
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%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), UCase(arrTranslit(iCount%)), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function
Результат работы (другой набор символов для замены, учитывается регистр)
Исходная строка: "А-Б-В-Г-Д-Е-Ё-Ж-З-И-Й-К-Л-М-Н-О-П-Р-С-Т-У-Ф-Х-Ц-Ч-Ш-Щ-Ъ-Ы-Ь-Э-Ю-Я"
Итоговая строка: "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"
|
|
