Как сделать транслитерацию?

компьютеры excel VBA макросы

Есть списки моделей в Excel'е. Названия моделей должны быть в латинице. но кое-кто (не смогу показать здесь пальцем) умудрился часть из них набрать русскими буквами (например, ТОР - должно быть TOP). Есть ли штатная функция или макрос по замене кириллических символов на аналогичные по написанию латинские?

PS Если нет, буду сам писать, просто неохота велосипед в очередной раз изобретать. Кстати, если кому такой макрос пригодился бы - дайте знать, сделаю - опубликую.

Примечание:
Посидел немного, получилось вот что:
Sub SymRep()
Dim Array_RusTbl(1 To 17) As String
Dim Array_LatTbl(1 To 17) As String
Dim i As Integer
' таблица кириллических символов
Array_RusTbl(1) = "А"
Array_RusTbl(2) = "В"
Array_RusTbl(3) = "Е"
Array_RusTbl(4) = "К"
Array_RusTbl(5) = "М"
Array_RusTbl(6) = "Н"
Array_RusTbl(7) = "О"
Array_RusTbl(8) = "Р"
Array_RusTbl(9) = "С"
Array_RusTbl(10) = "Т"
Array_RusTbl(11) = "Х"
Array_RusTbl(12) = "а"
Array_RusTbl(13) = "е"
Array_RusTbl(14) = "о"
Array_RusTbl(15) = "р"
Array_RusTbl(16) = "с"
Array_RusTbl(17) = "х"
' таблица соответствующих латинских символов:
Array_LatTbl(1) = "A"
Array_LatTbl(2) = "B"
Array_LatTbl(3) = "E"
Array_LatTbl(4) = "K"
Array_LatTbl(5) = "M"
Array_LatTbl(6) = "H"
Array_LatTbl(7) = "O"
Array_LatTbl(8) = "P"
Array_LatTbl(9) = "C"
Array_LatTbl(10) = "T"
Array_LatTbl(11) = "X"
Array_LatTbl(12) = "a"
Array_LatTbl(13) = "e"
Array_LatTbl(14) = "o"
Array_LatTbl(15) = "p"
Array_LatTbl(16) = "c"
Array_LatTbl(17) = "x"

For i = 1 To 17
Selection.Replace What:=Array_RusTbl(i), Replacement:=Array_LatTbl(i), LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=True
Next i

End Sub
Работает на выделенном диапазоне ячеек.
Ответы:
Одинаковые по написанию-это не транслит. Штатных функций нет.
Нужный код на VBA нагуглить сложно. [1] Быстрее написать самому. Лови код прототипа.
Function Sym2Lat(x)
   For i = 1 To Len(x)
       Sym2Lat = Sym2Lat + OneSym2Lat(Mid(x, i, 1))
   Next i
End Function
Function OneSym2Lat(sym)
   cyrS = "АВЕЗКМНОРСТХЧаезкорсхч"
   latS = "ABE3KMHOPCTX4ae3kopcx4"
   OneSym2Lat = sym
   For i = 1 To Len(cyrS)
       If sym = Mid(cyrS, i, 1) Then OneSym2Lat = Mid(latS, i, 1)
   Next i
End Function


15 лет назад

RPI.su - самая большая русскоязычная база вопросов и ответов. Наш проект был реализован как продолжение популярного сервиса otvety.google.ru, который был закрыт и удален 30 апреля 2015 года. Мы решили воскресить полезный сервис Ответы Гугл, чтобы любой человек смог публично узнать ответ на свой вопрос у интернет сообщества.

Все вопросы, добавленные на сайт ответов Google, мы скопировали и сохранили здесь. Имена старых пользователей также отображены в том виде, в котором они существовали ранее. Только нужно заново пройти регистрацию, чтобы иметь возможность задавать вопросы, или отвечать другим.

Чтобы связаться с нами по любому вопросу О САЙТЕ (реклама, сотрудничество, отзыв о сервисе), пишите на почту [email protected]. Только все общие вопросы размещайте на сайте, на них ответ по почте не предоставляется.