Блог mev'a

все, что я хотел сказать

Функция транслита для Excel

10 сентября 2010 • Полезное

Возникла давеча необходимость перегнать в Excel'е ряд строк в транслит. Функции такой в Excel'е конечно же нет.

Яндекс выдал ряд простых формул, но там не учитывался регистр символов. А регистр был нужен.

Пришлось писать самому.

Итак, под катом много кода для реализации транслита в Microsoft Excel и несколько примеров с криншотами на тему как вставить функцию в личную книгу макросов.

Часть первая. Код функции

  1. Public Function Translit(ByVal txt As String) As String
  2. iRussianLower$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
  3. iTranslit = Array("", _
  4. "a", "b", "v", _
  5. "g", "d", "e", _
  6. "yo", "zh", "z", _
  7. "i", "i", "k", _
  8. "l", "m", "n", _
  9. "o", "p", "r", _
  10. "s", "t", "u", _
  11. "f", "kh", "c", _
  12. "ch", "sh", "zch", _
  13. "''", "'y", "'", _
  14. "eh", "yu", "ya")
  15. Dim result$, char$, newChar$, charIndex%, nextChar$, lastChar$
  16. For i% = 1 To Len(txt)
  17. char = Mid(txt, i, 1)
  18. charIndex = InStr(1, iRussianLower, char, vbTextCompare)
  19. If (charIndex >= 1) Then
  20. newChar = iTranslit(charIndex)
  21. Else
  22. newChar = char
  23. End If
  24. ' если текущий символ прописной
  25. If (Asc(char) >= 132 And Asc(char) <= 223) Then
  26. ' если это первый символ
  27. If i = 1 Then
  28. ' если последующий прописной
  29. nextChar = Mid(txt, i + 1, 1)
  30. If (Asc(nextChar) >= 132 And Asc(nextChar) <= 223) Then
  31. result = result & StrConv(newChar, vbUpperCase)
  32. ' если последующий строчный
  33. ElseIf (Asc(nextChar) >= 224 And Asc(nextChar) <= 255) Then
  34. result = result & StrConv(newChar, vbProperCase)
  35. End If
  36. ' если это не первый и не последний символ
  37. ElseIf i > 1 And i <> Len(txt) Then
  38. nextChar = Mid(txt, i + 1, 1)
  39. lastChar = Mid(txt, i - 1, 1)
  40. ' если околостоящие прописные
  41. If ((Asc(lastChar) >= 132 And Asc(lastChar) <= 223)) _
  42. Or (Asc(nextChar) >= 132 And Asc(nextChar) <= 223) Then
  43. result = result & StrConv(newChar, vbUpperCase)
  44. ' иначе
  45. Else
  46. result = result & StrConv(newChar, vbProperCase)
  47. End If
  48. Else
  49. lastChar = Mid(txt, i - 1, 1)
  50. ' если предыдущий символ прописной
  51. If (Asc(lastChar) >= 132 And Asc(lastChar) <= 223) Then
  52. result = result & StrConv(newChar, vbProperCase)
  53. ' иначе
  54. Else
  55. result = result & StrConv(newChar, vbUpperCase)
  56. End If
  57. End If
  58. ' если текущий символ строчный
  59. ElseIf (Asc(char) >= 224 And Asc(char) <= 255) Then
  60. result = result & iTranslit(charIndex)
  61. ' если текущий символ не буква русского алфавита
  62. Else
  63. result = result & char
  64. End If
  65. Next i
  66. Translit$ = result
  67. End Function

Вот такая "нехитрая" формула позволяет получать такие строки:

Результат функции Translit в Excel

Результат функции Translit в Excel

Если вам не нравится порядок перевода (какие символы должны подставляться вместо "Ч", "Щ" и т.д.), то вы можете сами настроить перевод. Вам всего лишь надо заменить нужные символы в массиве iTranslit. Символы замены в нем располагаются по порядку русского алфавита.

Массив символов для замены при транслитерации

Массив символов для замены при транслитерации

Но сама формула вам ничего не даст. Ее необходимо поместить в Excel, чтобы ею можно было пользоваться.

Часть вторая. Внедрение функции в Excel

Вариант №1. Поместить функцию в конкретный файл

1) Заходим в редактор Visual Basic (Alt+F11)

2) Слева в обозревателе проектов найдите нужный файл и добавьте к нему Модуль

Добавление модуля к книге в Excel

Добавление модуля к книге в Excel

3) После добавления откроется чистый лист модуля. Скопируйте туда код.

4) Теперь функция будет доступна внутри вашего файла

Функция Translit доступна в файле Excel

Функция Translit доступна в файле Excel

Какие минусы у этого варианта размещения: функция будет работать только в этом файле. Использовать ее в других файлах не получится.

ЗЫ: Если у вас MS Office 2007, то не забудьте присохранении выбрать тип файла с поддержкой макросов.

Вариант №2. Поместить функцию в личную книгу макросов

Этот вариант предпочтительней, т.к. помещенную в личную книгу макросов функцию можно будет использовать в любом файле Excel на вашем компьютере.

1) Сначала надо создать личную книгу макросов. Для этого необходимо записать простенький макрос, Excel сам создаст книгу по требованию

Запись макроса в личную книгу макросов

Запись макроса в личную книгу макросов

2) Заходим в редактор Visual Basic (Alt+F11)

3) Слева в обозревателе проектов найдите PERSONAL.XLSB и дважды кликните по имеющемуся у него модулю Module1

4) Замените ненужный нам код макроса на код функции

5) Сохраните изменения, кдикнув по кнопке сохранения в меню. Теперь функция будет доступна вам из любого файла Excel на вашем компьютере

6) Функцию можно использовать, набрав в ячейке ее имя, указав перед ним личную книгу макросов

Использование функции Translit

Использование функции Translit

7) Еще проще эту функцию найти через вставку функции, выбрав в качестве категории пункт "Определенные пользователем"

Вставка функции Translit

Вставка функции Translit

OZON.ru - Книги | Excel 2010. Профессиональное программирование на VBA (+ CD-ROM) | Джон Уокенбах | Excel 2010 Power Programming with VBA | Купить книги: интернет-магазин / ISBN 978-5-8459-1721-8 OZON.ru - Книги | Excel 2010. Профессиональное программирование на VBA (+ CD-ROM) | Джон Уокенбах | Excel 2010 Power Programming with VBA | Купить книги: интернет-магазин / ISBN 978-5-8459-1721-8

Популярность: 3%

Связанные записи

Распечатать запись  Распечатать запись
Получить PDF
Добавить в Facebook Добавить в Twitter Добавить в Google-Buzz Добавить в Яндекс-закладки Добавить в Вконтакте

Метка:


Устали от проблем с машиной? Обратитесь за ремонтом генераторов форд фокус в АГС . насосы wilo

11 комментариев

  1. Света пишет 27 октября 2010 4:22 P

    Спасибо большое! очень помогла программа!

  2. Получение реальной ссылки из гиперрсылки в Excel | Блог mev'a пишет 2 декабря 2010 3:34 P

    [...] Эту функцию можно добавить в нужную книгу или в личную книгу макросов (во втором случае вы сможете ее использовать во всех книгах Excel). Как вставить функцию в личную книгу макросов можете узнать здесь. [...]

  3. igoriando пишет 6 декабря 2010 7:05 P

    Сижу перебиваю в транслит ручками огромный массив и думаю «неужели никто еще не придумал UDF для такой распространенной темы» :) и ваш блог первым выпадает в яндексе :)
    Спасибо! сэкономит мне кучу времени!

  4. diviner пишет 8 мая 2011 6:52 P

    Функция работает немного не корректно если все слово (исходное) написано большими буквами и последняя буква транслитерируется не в одну а в две латинские буквы. Результат: в латинице все буквы большие а последняя маленькая.
    Пример транслитерации украинского названия города Запорожье: ЗАПОРІЖЖЯ – ZAPORІZHZHYa. Как видим, последняя буква Я переходит в две буквы Ya хотя правильно было бы YA.

  5. Слава пишет 9 сентября 2011 8:28 P

    Спасибо. Огромное спасибо за статью «Внедрение функции в Excel». Неделю мучился – теперь я счастлив ))

  6. Николай пишет 13 сентября 2011 12:37 P

    Еще ошибка: Если строка начинается заглавной буквой, а за ней следует пробел, функция совсем отбрасывает первую букву. «В долине» -> » doline»
    Чтобы работало, можно 30ю строчку
    If (Asc(nextChar) >= 132 And Asc(nextChar) = 132 And Asc(nextChar) <= 223) Or Asc(nextChar) = 32 Then

  7. maximus пишет 14 сентября 2011 4:39 P

    Public Function ToTranslit$(iStr$)

    iRussian = Array(»", _
    «ЪЕ», «ЪЁ», «ЪИ», «ЪЮ», «ЪЯ», _
    «ЬЕ», «ЬЁ», «ЬИ», «ЬЮ», «ЬЯ», _
    «ъе», «ъё», «ъи», «ъю», «ъя», _
    «ье», «ьё», «ьи», «ью», «ья», _
    _
    «А», «Б», «В», «Г», «Д», «Е», _
    «Ё», «Ж», «З», «И», «Й», «К», _
    «Л», «М», «Н», «О», «П», «Р», _
    «С», «Т», «У», «Ф», «Х», «Ц», _
    «Ч», «Ш», «Щ», «Ъ», «Ы», «Ь», _
    «Э», «Ю», «Я», _
    _
    «а», «б», «в», «г», «д», «е», _
    «ё», «ж», «з», «и», «й», «к», _
    «л», «м», «н», «о», «п», «р», _
    «с», «т», «у», «ф», «х», «ц», _
    «ч», «ш», «щ», «ъ», «ы», «ь», _
    «э», «ю», «я»)

    iTranslit = Array(»", _
    «Ye», «Yo», «Yi», «Yu», «Ya», _
    «Iye», «Iyo», «Iyi», «Iyu», «Iya», _
    «ye», «yo», «yi», «yu», «ya», _
    «iye», «iyo», «iyi», «iyu», «iya», _
    _
    «A», «B», «V», «G», «D», «E», _
    «E», «Zh», «Z», «I», «Y», «K», _
    «L», «M», «N», «O», «P», «R», _
    «S», «T», «U», «F», «Kh», «Ts», _
    «Ch», «Sh», «Sch», «‘», «Y», «», _
    «E», «Yu», «Ya», _
    _
    «a», «b», «v», «g», «d», «e», _
    «e», «zh», «z», «i», «y», «k», _
    «l», «m», «n», «o», «p», «r», _
    «s», «t», «u», «f», «kh», «ts», _
    «ch», «sh», «sch», «‘», «y», «», _
    «e», «yu», «ya»)

    For iCount% = 1 To 86
    iStr$ = Replace(iStr$, iRussian(iCount%), iTranslit(iCount%), , , vbBinaryCompare)

    Next
    ToTranslit$ = iStr$
    End Function

  8. Hallie пишет 8 января 2012 2:53 P

    Нижайше благодарю, супер-прога!!!!

  9. Александр пишет 13 марта 2012 9:18 P

    Спасибо! Работает как надо. Еще бы знать как заставить формулу менять пробел на нижнее подчеркивание, было бы вовсе чудесно.

  10. Слава пишет 28 марта 2012 9:12 P

    Супер!!! Спасибо
    А что нужно сделать чтобы при сочетании «ый»
    перед «й» ставился пробел?
    Ещё раз спасибо

  11. u-n-o пишет 27 апреля 2012 1:56 P

    в целом по скрипту из «Части первой» мне подход понравился, пришлось только допилить баги:
    - ошибка транслитерации если исходная строка состоит только из одной заглавной кириллической буквы;
    - некорректная работа при скрипта при если исходный текст имеет форму: [] – отсутствует транслитерация первого символа.
    В остальном браво и огромное спасибо, мне как человеку незнакомому с VB, этот скрипт очень помог.

Оставить комментарий или два