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 --> шш жж
Вывод: учитывая возможное количество неопределённостей, проще обратную транслитерацию выполнять вручную.
Комментарии
Странно - почему то все равно в нижний регистр все приводит..
Это оказывается учтено!
Великолепный макрос!!!
А можно сделать, чтобы если в строке содержатся латинские буквы, они бы не преобразовывались.
Да запросто - теперь и регистр учитывается:
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%)) ' строчные
txt = Replace(txt, UCase(Mid(iRussian$, iCount%, 1)), UCase(iTranslit(iCount%))) ' прописные
Next
Translit$ = txt
End Function
Sub ПримерИспользованияФункцииTranslit()
txt = "Проверка Работы ТРАНСЛИТА"
newtxt = Translit(txt) ' результат = строка "Proverka Rabot'y TRANSLITA"
MsgBox "Строка """ & txt & """" & vbNewLine & "преобразована в строку """ _
& newtxt & """", vbInformation, "Результат обработки"
End Sub
Здорово! Хотелось бы еще учет больших-маленьких букв
Отправить комментарий