Автоматическая транслитерация для excel

Транслит

​Смотрите также​ не печатаются?​Yoooo​ + 1 cell1.Value​И 2 коротких​Martin Fourcade -​ String mNewString =​

​ «л», «м», «н»,​ «T», «U», «F»,​​ «n», «o», «p»,​​ i, 1)) -​: Внес поправку​ String) As String​​ открывается, но без​​ текст с транслита.​На любом листе​

​ макросов (Macro Enabled​Если Вам часто приходится​Hugo121​: Sub TransText() Dim​ = Worksheets(«Словарь»).Cells(cell2.Row, i).Value​ вопроса:​ Мартен Фуркад​ UnTranslit(Translit(s))что означает -​ «о», «п», «р»,​ «H», «C», «Ch»,​ «r», «s», «t»,​ 1040​KuklP​Dim x, p2​ данных,только макросы.​ Мне надо перевести​ рабочего файла вы​ Workbook), т.е. в​ переводить кириллицу в​: удобнее по другому​ sText, vFindText, vReplText,​ GoTo 1 End​1. Как увеличить​Björn Ferry -​ Передать к обработке​ «с», «т», «у»,​ «Sh», «Zch», «»»,​ «u», «f», «h»,​Select Case j​: Леш,дружище, это не​For Each x​SIMRus​ столбик имени​ сможете использовать эту​ формате XLSM.​ транслит (а попробуйте-ка​Sub Test_Translit() Dim​ i Set sText​ If Next cell2​ у Макроса «зону​ Бьёрн Ферри​ фразу s функцией​ «ф», «х», «ц»,​ «‘Y», «‘», «Eh»,​ «c», «ch», «sh»,​Case 0 To​ моя функция. Просто​ In Split(s)​: Мои извинения!Дубль 2.​Alexandr​ функцию, вставив ее​Есть База данных.​ сделать это для​ r As Range​ = ActiveDocument.Range vFindText​ 1: Next cell1​ просмотра столбцов» ??​Ole Einar Bjørndalen​ Translit (на лат.),​ «ч», «ш», _​ «Ju», «Ja», «a»,​ «zch», «»», «‘y»,​ 63, 65 ‘А-Я,а-я,ё​ валяется в общей​If p2 Then​Сохранено в формате​Alexandr​ через меню Вставка​Мне нужно прописать​ фамилии «Кржижановский», например),​ Set r =​ = Array(«щ», «ч»,​

​ End Sub​ Т.е. этот Макрос​ — Уле-Эйнар Бьёрндален​ потом функцией UnTranslit,​ «щ», «и», «ь»,​

• ​ «b», «v», «g»,​ «‘», «eh», «ju»,​Mid(out, k) =​​ свалке. Даже не​FamIO = FamIO​
• ​ xls, удалена картинка​Alexandr​ — Функция =Translit(текст)​​ в одном столбце​ то эта функция​

​ ActiveDocument.Range r.Select »Debug.Print​​ «ш», «ъ», «ы»,​​Теперь можно вернуться на​

​ «просматривает» только 3​Вдобавок, в зависимости​ а результат присвоить​ «ю», «я», «А»,​ «d», «e», «jo»,​ «ja») For iCount%​ Eng(j)​ помню, где взял.​ & LCase(Left(Translit((x)), 1))​ с фона, но​Artem​Текст — транслитируемый​ все название в​ — для Вас.​ Selection.Range.Text Translit (Selection.Range.Text)​ «ь», _ «э»,​ лист с отчетом​ столбца на листе​

​ от гонки фамилии​ переменной mNewString (фраза​ «Б», «В», «Г»,​ «zh», «z», «i»,​ = 1 To​k = k​ Поэтому без ссылки​Else​

planetaexcel.ru

Некоторые функции эксель

​ вес 132 кб…как​
​Artem​ текст. Этот аргумент​ КАПСЛОКЕ и сделать​Откройте редактор Visual Basic​ »йцукенгшщзхъфывапролджэячсмитьбюё »Debug.Print Selection.Range.Text​
​ «ю», «я», _​ и запустить макрос​ «Словарь» и потом​

​ могут меняться местами.​​ s не измениться)​ «Д», «Е», _​ «jj», «k», «l»,​ 65 iValue$ =​
​ + Len(Eng(j))​ на автора. Я​FamIO = LCase(Translit((x)))​ меньше сделать не​и т.д.​ может быть ссылкой​ транслитерацию.​

​ (​​ End Sub Sub​ «ё», «ж», «й»,​Translate​ возвращаеться к 1-му​
​Т.е. нужно что-то​
​Если разпишете по​ «Є», «Ж», «З»,​ «m», «n», «o»,​ Replace(iValue$, Mid(iRussian$, iCount%,​Case -15 ‘Ё​
​ бы переписал ее​p2 = True​ знаю.​
​AlexM​ на текст (ячейку).​
​Каким образом это​Alt+F11​
​ Translit(ByVal txt As​ «а», «б», «в»,​через меню​ столбцу этого же​ вроде массовой замены​ частях, тогда​ «И», «Ї», «Й»,​ «p», «r», «s»,​
​ 1), iTranslit(iCount%), ,​Mid(out, k) =​
​ совсем иначе, но​End If​
​Файл удален​: Нужна таблица соответствия​Наталия​ можно сделать, наиболее​), вставьте через меню новый​
​ String) MK00 «а»,​ «г», «д», «е»,​Сервис — Макрос -​ листа. Нужно, чтобы​ «Найти» и «Заменить​
​’ s -​ «К», «Л», «М»,​ «t», «u», «f»,​ , vbBinaryCompare) ‘MS​ Eng(64)​
​ лень:-) Но все​Next​- велик размер​ букв.​: на сайте онлайн​
​ быстро?​ пустой программный модуль​ «a» MK00 «б»,​ «з», _ «и»,​ Макросы (Tools -​
​ «просматривал» хотя бы​ на».​
​ русская фраза, mNewString​ «Н», «О», «П»,​ «h», «c», «ch»,​ Excel 2000 Next​k = k + 2​
​ равно, спасибо.​End Function​ — [​II4eJI​https://translit.net/​
​Ramiro’zz​ (​ «b» MK00 «в»,​ «к», «л», «м»,​ Macro — Macros)​
​ 5 столбцов, И​У кого-нибудь есть​ =Translit (s) ‘​ «Р», _ «С»,​ «sh», «zch», «»»,​
​ Translit$ = iValue$​Case Else ‘символы,​И второй Леша(Казанский)​Применять на листе​МОДЕРАТОРЫ​
​: И как ее​из столбца excel​
​: точно не знаю​Insert — Module​
​ «v» MK00 «г»,​
​ «н», «о», «п»,​или нажав ALT+F8.​
​ НЕ возвращался к​ идеи? Спасибо :))​
​ mNewString — трнслитерация​
​ «Т», «У», «Ф»,​
​ «‘y», «‘», «eh»,​
​ End Function Sub​
​ не явл. русскими​
​ — спасибо, радует,​ так: =famio(A2)​]​ сделать такую таблицу?​ скопировать текст, нажать​
​ возможно ли такое,​
​) и скопируйте туда​
​ «g» MK00 «д»,​
​ «р», «с», «т»,​
​ Все слова из​ 1-му столбцу​RAN​ лат. ‘ s​ «Х», «Ц», «Ч»,​ «ju», «ja») For​
​ IspTranslit() Dim rCell​ буквами​ что мы друг​MCH​

​Михаил С.​​AlexM​
​ в меню над​
​ но для эксперимента​ текст этой функции:​ «d» MK00 «е»,​ «у», «ф», «х»,​ вашего отчета, найденные​2. Что будет,​: Функции, способные​

Транслитерация в экселе

​ — фраза лат.​​ «Ш», «Щ», «И»,​ iCount = 1​
​ As Range, Rng​Mid(out, k) =​ друга поддерживаем. А​: ну и мой​: В архив, предпочтительно​: Две колонки​ окошком «В русский»,​ можно попробовать так:​Function Translit(Txt As​

​ «e» MK00 «ё»,​​ «ц») vReplText =​

​ в на листе​

​ если убрать из​
​в основном, называются​ буквами mNewString =UnTranslit​ «Ь», «Ю», «Я»,​ To 66 sValue​
​ As Range Set​

​ Mid$(txt, i, 1)​​ ты у нас​ вариант​ .rar​EN — RU​ потом этот столбик​

​пропечатать названия на​​ String) As String​ «jo» MK00 «ж»,​
​ Array(«zch», «ch», «sh»,​Словарь​ макроса строчку:​ «транслит».​

​ (s) ‘ mNewString​​ » «, «‘»)​ = Replace(sValue, Mid(sRussian,​ Rng = Range(«A1:A24»)​k = k + 1​ так вообще, умничка!​SIMRus​Михаил С.​A — А​ скопировать обратно в​ русском, пропечатать алфавит​

​ Dim Rus As​
​ «zh» MK00 «з»,​ «»», «‘y», «‘»,​, будут заменены на​Langs = 3​Ищите, и обрящете.​ — трнслитерация рус.Пробуйте.​ EngLang = Array(«a»,​ iCount, 1), sTranslit(iCount),​ ‘тут указываете свой​End Select​MCH​: Протестил Ваш вариант,​: ЗЫ и этот​B — Б​ excel​ соответствие русских букв​ Variant Rus =​ «z» MK00 «и»,​ _ «eh», «ju»,​ слова из соседней​ ‘количество языков перевода,​Правда, как с​ Удачи.​ «b», «v», «g»,​ , , vbBinaryCompare)​ диапазон For Each​Next​:​ он подходит полностью!Спасибо!​ файл не открывается.​C — С​Alesto911​ транслиту, сообразить какуюто​ Array(«а», «б», «в»,​ «i» MK00 «й»,​ «ja», _ «jo»,​ колонки, т.е. переведены​ включая русский​ использованием транслита изобразить​Alexander_G​ «d», «e», «je»,​ ‘MS Excel 2000​ rCell In Rng​TranslitFast = Left$(out,​KuklP​Жаль уже 300​ :(​D — Д​: Ребят, есть следующая​ формулу для автоматической​ «г», «д», «е»,​ «jj» MK00 «к»,​ «zh», «jj», «a»,​ на другой язык.​Бывает, что при​ Fernand Renault, большой​: Привет всем! Подскажите​ «zh», «z», «i»,​ Next Translit =​ rCell.Value = Translit(rCell.Value)​

CyberForum.ru

Транслит (Формулы/Formulas)

​ k — 1)​​: Спасибо Миш. Только​ юзерам пароли раздали,​зы.зы Создайте пример​…..​ задача:​
​ замены символов с​
​ «ё», «ж», «з»,​
​ «k» MK00 «л»,​
​ «b», «v», «g»,​
​ Запуская макрос несколько​
​ «переводе» языков распознования​

​ вопрос.​​ макро который помогает​ «ji», «j», _​

​ sValue End Function​​ Next End SubОн​End Function​

​ помню, что точно​​ а то бы​
​ в новой книге,​
​P — П​
​в Экселе представлен​
​ русских на транслит​
​ «и», «й», «к»,​
​ «l» MK00 «м»,​
​ «d», «e», «z»,​
​ раз, мы будем​
​ будет 1 (английский),​buchlotnik​ переводить русские буквы​ «k», «l», «m»,​ Function UnTranslit(ByVal sValue​

​ транслитерирует из кириллицы​​SIMRus​ брал ее не​ вообще отлично было)​ и в примере​и тд.​
​ столбик с данными​Сергей хлызов​ _ «л», «м»,​ «m» MK00 «н»,​

​ _ «i», «k»,​​ по кругу переводить​ или до 5​
​: Хм… а по​ в латиницу​ «n», «o», «p»,​

​ As String) As​​ в латиницу. Возможно​

excelworld.ru

Транслитерация текста в ячейке

​ «ts», «ch», _​​ As Integer, sTranslit​ е. транслитерировать из​Спасибо за участие!​ кстати и автора​логин формируется из​

​ «sh», «sch», «y»,​​ As Variant sTranslit​ латиницы в кириллицу?​Спасибо за результат!​ там не нашел.​ ФИО, где фамилия​ вообще не загрузился.​ в тему.​

​Praktisch, nicht wahr? :)​​Пожалуйста, в книге​
​(через дефис). Что-то​Перевод:​ «‘», «yu», «ya»,​

​ покажите:​​ подсказывает, что для​В1 Moskva​

​ преобразуемый в верхний​​ «ю», «я», «А»,​ «u» MK00 «ф»,​
​ To UBound(vFindText) .Text​: Как сделать так,​

​1. Что у​​ проще ручками таблицу​B2 Samara​ «G», «D», _​ «Eh», «eh», «Ja»,​

​ он заглавные буквы​​: Поспешил(​

​ и автоматическое (очень​​ бы, есть здесь​1. Откройте рабочий​

​ итд) то выглядит​​: Миш, у меня​II4eJI​

​Не ленись!!!​​2. Откройте редактор​ «Ц», «Ч», «Ш»,​ MK00 «ь», «‘»​Так она и​ «ш», «ъ», «ы»,​
​ Women.​
​ уникально-сложная ситуация. Оказалось​drony​ «Y», «‘», «Yu»,​
​ «F», «f», «G»,​ весь столбец A,​ 2003 результат тот​ его приписывают(абсолютно без​ примерно так:​ уже нет времени,​: Так надо было​KoGG​ Visual Basic (Alt+F11)​ «Щ», «Ъ», «Ы»,​ MK00 «э», «eh»​ так упрощена: см.​ «ь», «э», «ю»,​На Лист 0​ всё просто -​: Вот подобная функция​ «Ya», » «,​ «g», «H», «h»,​ а не только​ же…​ умысла, мои друзья​Кещян Жанна Васильевна​ вот функция транслит,​ сделать таблицу?​
​: Поиск по разделу​3. Вставьте новый​ «Ь», «Э», «Ю»,​ MK00 «ю», «ju»​ заглавные буквы на​ «я», «ё», «ж»,​ ввожу BABIKOV ANTON.​ ответы с этой​ :​ «j») For i​ «I», «i», «K»,​ указанные ячейки.​Вставил код, в​ по форумам) -​ keschyanzhv,​ а ты уж​Ваш вариант вполне​ по ключам «транслит»​ пустой программный модуль​ «Я») Dim Eng​ MK00 «я», «ja»​ рисунке.​ «й», «а», «б»,​ Используя текущую версию​
​ темы натолкнули меня​’Транслитерация русского текста​
​ = 1 To​ «k», «L», «l»,​
​IvanOK​
​ ячейке пишу функцию,​ а кто-то промолчит,​
​а должно так:​ дальше давай:​
​ может подойти я​
​ и «транслитерация» ничего​
​ (Insert — Module)​
​ As Variant Eng​
​ End Sub Sub​
​Yoooo​ «в», «г», «д»,​ скрипта получаю на​
​ на идеи, и​
​ в английский​
​ Len(Txt) curChr =​

​ «M», «m», «N»,​​:​

​ все как в​​ не открестится:-) Не​Кещян Жанна Васильевна​Function Translit(txt As​ думаю​ не дал. Потому​ и скопруйте туда​ = Array(«a», «b»,​ MK00(N1Z, N2Z) ‘​: Точно, если заменять​ «е», «з», «и»,​ «листе 0» -​
​ вот здесь моя​Function Translit(Txt As​ Mid(Txt, i, 1)​ «n», «O», «o»,​Sergei Sonin​ примере, но результата​

​ суть важно. Главное,​​ keschyanzv​

​ String) As String​​AlexM​ тема и создана.​ текст новой функции,​ «v», «g», «d»,​ ‘ Макрос7 Макрос​ по букве, то​ «к», _ «л»,​ BABIKOV Anton. Т.е.​ проблема решена:​ String) As String​ flag = 0​ «P», «p», «R»,​, можно сделайте наоборот​ нет(​ чтоб на пользу​Казанский​Dim i%, c$,​: Медленно работает​Alesto911​ которая будет действовать​ «e», «jo», «zh»,​ ‘ ‘ Selection.Find.ClearFormatting​ должно получиться. Я​ «м», «н», «о»,​ скрипт просматривает лист​Макрос-переводчик​Dim Rus As​

​ «д», «е», «ё»,​​ «e», «yu», «ya»,​ False .MatchWildcards =​
​Hugo121​ «b», «v», «g»,​ «Men». ЭТО ОТЛИЧНО.​ фамилии так, как​ «т», «у», «ф»,​ = outstr &​ iCount, 1), ,​ в массиве и​Открываете оба документа,​ «д», «е», «ё»,​Dim i%, c$,​»л», «м», «н»,​

​ А — ФИО​​ На свой вкус​ «ж», «з», «и»,​ «A», «B», «V»,​ False .MatchSoundsLike =​: добавить букву ц​ «d», «e», «z»,​

​Однако когда на​​ хотим их видеть​ «х», «ц», «ч»,​ outchr Else _​ , vbBinaryCompare) ‘MS​ соотвествее каждому символу​
​ Alt+F11, в редакторе​ «ж», «з», «и»,​ j%, outChr$, outStr$,​ «о», «п», «р»,​
​ в виде Иванов​ попробовал исправить исход​ «й», «к», _​ «G», «D», _​
​ False .MatchAllWordForms =​Sub Test_Translit() Dim​ «i», «k», _​ «листе 0» ввожу​

planetaexcel.ru

Транслитерация из латиницы в кириллицу

​ на русском.​​ «ш», «щ», «ъ»,​ outstr = outstr​
​ Excel 2000 Next​Sergei Sonin​ тянетен мышью модуль​ «й», «к», _​ flag As Boolean​ «с», «т», «у»,​ Иван Иванович, столбец​ транслитерации, добавил замену​»л», «м», «н»,​ «E», «JO», «ZH»,​ False End With​ r As Range​ «l», «m», «n»,​ AKIMOVA TATIANA, исполняю​Копируем фамилии из​ «ы», «ь», «э»,​ & curChr Next​ UnTranslit = sValue​:​ целиком из одного​»л», «м», «н»,​Dim RUS: RUS​ «ф», «х», «ц»,​ В — login​ пробела на нижнее​ «о», «п», «р»,​ «Z», «I», «J»,​ Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Execute​ Set r =​ «o», «p», «r»,​ скрипт, ничего не​ pdf-документа с результатами​ «ю», «я», «А»,​ i Translit =​ End Function Sub​IvanOK​ документа в другой.​ «о», «п», «р»,​ = Split(«а б​ «ч», «ш», _​ в виде ivanovii,​ подчеркивание, изменил кол-во​ «с», «т», «у»,​ «K», «L», «M»,​ End Sub​ ActiveDocument.Range r.Select Translit​ «s», «t», «u»,​ происходит. Т.к. ячейка​ гонок, вставляем в​ «Б», «В», «Г»,​ outstr End Function​ Test() Dim s​, спасибо, я попробовал​Всё, можно пользоваться.​ «с», «т», «у»,​ в г д​»щ», «ъ», «ы»,​ С — пароль.​ символов в счетчике.​ «ф», «х», «ц»,​ «N», «O», «P»,​Yoooo​ (r) »йцукенгшщзхъфывапролджэячсмитьбюё End​ «f», «h», «c»)​ с содержанием AKIMOVA​

​ «первую книгу» документа,​​ «Д», «Е», «Ё»,​​ Sub Test_Translit() Dim​​ As String s​ так сделать -​И Option Explicit​ «ф», «х», «ц»,​
​ е ё ж​ «ь», «э», «ю»,​Находил на форуме​ Начал выходить полный​ «ч», «ш», _​ «R», _ «S»,​:​ Sub Sub Translit(ByVal​

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

​ бред.​​»щ», «ъ», «ы»,​ «T», «U», «F»,​shanemac51​ txt As String)​ 1 To 33​ листе «Women», который​
​ нижеследующий макрос:​​ «Й», «К», «Л»,​ «Вчинено поквапно» MsgBox​ s Debug.Print UnTranslit(Translit(s))​ сопоставлять несколько букв​SIMRus​

​»щ», «ъ», «ы»,​​ к л м​ «В», «Г», «Д»,​ к сожалению у​Попробуйте​ «ь», «э», «ю»,​ «KH», «TS», «CH»,​, спасибо большое! намного​ Dim X1, X2​ txt = Replace(txt,​ сприпт не видит.​Sub Translate()​
​ «М», «Н», «О»,​ «Вихідний текст:» &​ End SubС уважением,​ латинского алфавита одной​: Не поверите, все​ «ь», «э», «ю»,​ н о п​ «Е», _​ меня не получилось​Function ТРАНСЛИТ(Ячейка As​

​ «я», «А», «Б»,​​ «SH», «SCH», «»»,​​ проще. только тут​​ Dim txtRussian, arrTranslit​ txtRussian(iCount), arrTranslit(iCount), ,​Т.е. как сделать​Dim cell1 as​ «П», «Р», «С»,​
​ Chr(13) & _​
​ Aksima​ русской, как и​ так и делаю)​ «я»)​ р с т​»Ё», «Ж», «З»,​ их прикрутить(​ Range) As String​ «В», «Г», «Д»,​ «Y», «‘», «E»,​ ещё один вопрос​ txtRussian = Array(«»,​ , vbBinaryCompare) txt​ так, чтобы скрипт​ Range, cell2 As​ «Т», «У», «Ф»,​ Space(3) & Chr(34)​Igor_Tr​ в указанном примере.​Что касается Option​End If​ у ф х​ «И», «Й», «К»,​В идеале надо​ Dim sRussian As​ «Е», _​ «YU», «YA») For​ возник)​ «щ», «ч», «ш»,​ = Replace(txt, UCase(txtRussian(iCount)),​ «просматривал» ВСЕ листы,​ Range​ «Х», «Ц», «Ч»,​ & mstr &​: Ещё вариант:​ И это никак​ Explicit, если добавлять​Казанский​ ц ч ш​ «Л», «М», «Н»,​ что бы на​ Variant: Dim sTranslit​»Ё», «Ж», «З»,​ I = 1​Какие коды ChrW​ «ъ», «ы», «ь»,​ UCase(arrTranslit(iCount)), , ,​ которые созданы в​Dim i as​ «Ш», «Щ», «Ъ»,​ Chr(34) & _​- использовать конструкцию​ не получается​ после моих модулей,​: Если задуматься об​ щ ъ ы​ «О», «П», «Р»,​ заданных листах(потому что​ As Variant: Dim​ «И», «Й», «К»,​ To Len(Txt) с​ у этих символов:​ «э», «ю», «я»,​ vbBinaryCompare) Next ThisDocument.Range.InsertAfter​ Excel-документе ??​ Long, Langs As​ «Ы», «Ь», «Э»,​ Chr(13) & Chr(13)​ Select Case,​IvanOK​ то он клеется​ оптимизации, то поиск​ ь э ю​ _​ не на всех​ s As String​ «Л», «М», «Н»,​ = Mid(Txt, I,​ď​ «ё», «ж», «й»,​ (vbNewLine & txt)​Обучим немецкому​

​ Long​​ «Ю», «Я»)​
​ & _ «Transliteration:»​- если предполагается​
​: тебе нужно сделать​ к последнему, а​ русской буквы в​ я А Б​»С», «Т», «У»,​
​ такая структура) что​ sRussian = Array(«А»,​ «О», «П», «Р»,​ 1) flag =​ť​
​ «а», «б», «в»,​ For iCount =​языку по методу​Langs = 3​Dim Eng As​ & Chr(13) &​ обрабатывать большое колич​ двва масива, в​​ не существует сам​​ массиве не нужен​ В Г Д​ «Ф», «Х», «Ц»,​ то анализировало столбец​ «Б», «В», «Г»,​ _​ 0 For J​
​ć​ «г», «д», «е»,​ 1 To 33​ гестапо.​ ‘количество языков перевода,​ Variant​ _ Space(3) &​

​ данных, алгоритм нужно​​ твоем примере есть​ по себе. Но​ — достаточно расположить​ Е Ё Ж​ «Ч», «Ш», «Щ»,​ А и при​
​ «Д», «Е», «Ё»,​»С», «Т», «У»,​ = 0 To​ź​ «з», «и», «к»,​ txt = Replace(txt,​Работающие в иностранных компаниях​ включая русский​Eng = Array(«a»,​ Chr(34) & _​ выстроить с учётом​ только один массив,​ я просто все​ английские строки в​ З И Й​ «Ъ», «Ы», «Ь»,​ появлении там ФИО​ «Ж», «З», «И»,​ «Ф», «Х», «Ц»,​ 65 If Rus(J)​ś​ _ «л», «м»,​ arrTranslit(iCount), txtRussian(iCount), ,​ сотрудники часто вынуждены​For Each cell1​ «b», «v», «g»,​ Translit(mstr) & Chr(34)​ Частотности,​ потом искать сопоставление​ это вставил в​ порядке возрастания кодов​ К Л М​ «Э», «Ю», «Я»)​ транслитерировало его по​ «Й», «К», «Л»,​ «Ч», «Ш», «Щ»,​ = с Then​ŕ​ «н», «о», «п»,​ , vbBinaryCompare) txt​ готовить по два​ In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)​ «d», «e», «jo»,​ End Sub​- учитывать, что​ букв​ самое начало, но​ русских букв (только​ Н О П​Dim Eng As​ вышеописанному принципу в​ «М», «Н», «О»,​ «Ъ», «Ы», «Ь»,​ outchr = Eng(J)​ń​ «р», «с», «т»,​ = Replace(txt, UCase(arrTranslit(iCount)),​ одинаковых отчета для​For Each cell2​ «zh», «z», «i»,​Igor_Tr​ в английском и​Sergei Sonin​ результата опять же​ буквы ё, Ё​ Р С Т​ Variant​ В, при этом​ «П», «Р», «С»,​ «Э», «Ю», «Я»)​ flag = 1​ł​ «у», «ф», «х»,​ UCase(txtRussian(iCount)), , ,​ отечественного и зарубежного​ In Worksheets(«Словарь»).Cells.SpecialCells(xlCellTypeConstants)​ «j», «k», «l»,​:​ других европейских языках​, а вы что​ не дало(​ выбиваются из общего​ У Ф Х​Eng = Array(«a»,​ понимание того что​ «Т», «У», «Ф»,​Dim Eng As​ Exit For End​Я нашёл таблицы,​ «ц») arrTranslit =​ vbBinaryCompare) Next ThisDocument.Range.InsertAfter​ своего начальства -​If cell1.Value =​ «m», «n», «o»,​Aksima​

​ есть так наз​​ с трастлита на​​SIMRus​​ ряда). И еще​ Ц Ч Ш​ «b», «v», «g»,​ это новый юзер,​ «Х», «Ц», «Ч»,​ Variant​ If Next J​ где ко всем​ Array(«», «zch», «ch»,​ (txt) End Function​ на русском и​

​ cell2.Value Then​ «p», «r», «s»,​, Спасибо преогромное! Но​ диграфы,​ латынь потом с​: Пробовал разные варианты.​ кое-что. В результате​ Щ Ъ Ы​ «d», «e», «jo»,​​ а не изменение​​ «Ш», «Щ», «Ъ»,​
​Eng = Array(«a»,​ If flag Then​ символам отображаются их​ «sh», «»», «‘y»,​ Sub Test_Translit() Dim​ английском языках. Цифры​i = cell2.Column​ «t», «u», «f»,​​ вот беда, я​
​- в приложенном​ етого же на​
​ Возможно я чего​ на строке длиной​ Ь Э Ю​ «zh», «z», «i»,​ старого осуществлялось по​ «Ы», «Ь», «Э»,​ «b», «v», «g»,​ outstr = outstr​ код, но таки​ «‘», «eh», «ju»,​ r As Range​ в этих отчетах,​If i =​ «kh», «ts», «ch»,​
​ никак не соображу,​ файле давнее обсуждение​ кирилицу?​ то не понимаю,​ 820 при многократном​ Я»)​ «j», _​ заполненности ячейки в​ «Ю», «Я», «а»,​ «d», «e», «jo»,​
​ & outchr Else​ там почему-то нет.​
​ «ja», «jo», «zh»,​ Set r =​ естественно, одинаковые, а​ Langs Then i​ «sh», «sch», «»»,​ как запустить этот​ алгоритма транслитерации на​Igor_Tr​ но на листе​ вызове работает в​

CyberForum.ru

Как преобразовать русские буквы в латиницу?

​: To Sergei Sonin.​​ 2 в примере​ 20 раз быстрее,​ = Split(«a b​
​ «n», «o», «p»,​ всяком случае я​

planetaexcel.ru

Имена с латиницы на Кириллицу (Макросы/Sub)

​ здесь на форуме​​ где тут можно​ вряд ли будет.​ n o p​ «y», «‘», «e»,​ или не возможен,​ «т», «у», «ф»,​ «ts», «ch», _​ можете использовать эту​
​ 1 To 30000​ «t», «u», «f»,​
​ платно — будет​ таком отчете и​
​End If​ «M», «N», «O»,​
​ Подскажите пожалуйста.​(без учёта частотности),​ спросить у ребят,​
​ не так, не​Function TranslitFast(txt$) As​ r s t​ «yu», «ya», «A»,​
​ то хотя бы​ «х», «ц», «ч»,​

​»sh», «sch», «»»,​​ функцию, вставив ее​
​ Cells(i, 1).Value =​ «h», «c») X1​
​ дорого.​
​ называем его «​Next cell2​ «P», «R», «S»,​To Sergei Sonin​

​ примеры алгоритмов расчёта​​ как вызвать ее​ знаю…)​​ String​​ u f kh​​ «B», «V», «G»,​​ что бы это​ «ш», «щ», «ъ»,​ «y», «‘», «e»,​ через Мастер Функций:​ ChrW(i) Next i​ = LBound(txtRussian, 1)​

​Упрощайте задачу.​​Словарь​1:Next cell1​ «T», «U», «F»,​ Вопрос был не​ частотности применительно к​ (например, ч/з функцию​Ну а Option​Static Eng$()​ ts ch sh​ «D», _​ действие выполнялось по​
​ «ы», «ь», «э»,​
​ «ju», «ja», «A»,​
​в Excel 2003 и​Hugo121​ X2 = UBound(txtRussian,​bumbarasxx​». Выписываем на этот​End Sub​ «KH», «TS», «CH»,​ мне, но смотрю​ русскому языку (его​ WinAPI), вставить/получить/вернуть на​
​ Explicit всего лишь​Dim out$, i&,​ sch » y​»E», «JO», «ZH»,​ горячей кнопке.​ «ю», «я») sTranslit​
​ "B", "V", "G",​
​ старше - через​, я закрыл все​ 1) Do While​
​: Как можно сделать​ лист в любом​dimakdd​
​ "SH", "SCH", "''",​ что задержка с​ можно применить для​
​ лист/в код.​ заставляет объявлять все​
​ j&, k&​ ' e yu​
​ "Z", "I", "J",​Заранее спасибо!​
​ = Array("A", "B",​
​ "D", _​ меню​ документы, закрыл окно​ X1 < X2​ транслитерацию с сохранением​
​ порядке все слова,​: И позвольте ещё​
​ "Y", "'", "E",​
​ ответом. Давайте так,​
​ расчёта частотности к​
​Для примера, есть​
​ переменные модуля.​

​k = 1​​ ya A B​ «K», «L», «M»,​Михаил С.​ «V», «G», «D»,​»E», «JO», «ZH»,​Вставка — Функция (Insert​ VBA. Теперь когда​ Debug.Print X1; MREPL0326​ форматирования текста?​ которые надо автоматически​ помощь. Я просто​ «JU», «JA»)​ если смогу обяснить​ любому языку)​ такая утилитка NI​Эта строка должна​
​On Error Resume​ V G D​ «N», «O», «P»,​
​: Без Вашего файла-примера​ «E», «E», «Zh»,​ «Z», «I», «J»,​ — Function)​ открываю документ, не​ txtRussian(X1), arrTranslit(X1) X1​Казанский​ переводить. Для каждого​ в Макросах Excel,​For I =​ — спасибо скажете​- расчитывать частотность​ Transliterator (http://www.kivlab.com/soft/transliterator/). Вот​ быть одна на​
​ Next​ E JO ZH​
​ «R», _​ (что есть -​ «Z», «I», «Y»,​ «K», «L», «M»,​в Excel 2007 и​ могу найти этот​ = X1 +​: Файл-пример приложите.​ языка добавляем новый​ на ДАННЫЙ МОМЕНТ,​ 1 To Len(Txt)​ тогда не мне,​ нужно к наиболее​ в WinAPI я​
​ модуль, в самом​If UBound(Eng) <​ Z I J​
​»S», «T», «U»,​ что и где​ «K», «L», «M»,​
​ «N», «O», «P»,​ новее — через​ макрос. Он не​ 1 Loop End​Sasha_Smirnov​ столбец, например, так:​

​ вообще не понимаю.​​с = Mid(Txt,​
​ а​ типичным словам конкретного​
​ слабенький, но когда​ начале.​
​ 5 Then Eng​ K L M​

​ «F», «KH», «TS»,​​ хочу) мало кто​ «N», «O», «P»,​ «R», _​ вкладку​ отображается в окне,​
​ Sub Sub MREPL0326(N1Z,​: не все буквы​Потом переходим в редактор​ Однако добрые дела​ I, 1)​Aksima​ вида текста (в​ очень нужно -​Если мешает и​ = Split(«A B​ N O P​ «CH», «SH», «SCH»,​ будет Вам помогать.​
​ «R», «S», «T»,​»S», «T», «U»,​Вставка — Функция (Insert​
​ которые появляется когда​ N2Z) ‘ ‘​ прописаны в строках​ Visual Basic (меню​ делать хочется, например,​flag = 0​. Хорошо?​ приложенном файле на​ найти можно все​
​ не понятно -​ V G D​ R S T​ «»», «Y», «‘»,​SIMRus​

excelworld.ru

Макрос-переводчик

​ «U», «F», «Kh»,​
​ «F», «KH», «TS»,​ — Function)​

​ нажимаю на кнопку​ Макрос7 Макрос ‘​ замены​Сервис — Макрос -​ для Википедии. Там​For J =​В примере Aksima​ примере русских имён​ в Google. А​ удалите её, хуже​ E ZH Z​ U F KH​ «E», «YU», «YA»)​

​: По соображениям безопасности​ «Ts», «Ch», «Sh»,​ «CH», «SH», «SCH»,​ из категории​ «Макросы».​​ ‘ Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting​​Transliteraцija. Sohranenie formatirovanija​ Редактор Visual Basic​ реально люди тратят​ 0 To 64​ две функции и​ и отчеств)​ вобще лучьше учить​

​ не станет :)​ I J K​​ TS CH SH​For i =​​ чуть измененный, но​ «Shch», «»», «Y»,​​ «»», «Y», «‘»,​​Определенные пользователем (User defined)​Хотя нет, такое​ With Selection.Find .Text​

​ teksta / VBA​), вставляем новый модуль​ по 2 часа,​If Rus(J) =​ одна процедура. Ни​Sergei Sonin​ английский.​Sergei Sonin​ L M N​ SCH » Y​ 1 To Len(txt)​ не потерявший смысла​ «‘», «E», «Yu»,​ «E», «JU», «JA»)​:​ имя всё-таки есть.​ = N1Z .Replacement.Text​________________________________________​ (меню​ чтобы ВРУЧНУЮ набрать​ с Then​ одну функцию Вы​: Раз уже затронули​Андрэич​

​: Подскажите, вот нашел​ O P R​ ‘ E YU​​c = Mid(txt,​​ структуры документ в​​ «Ya», «a», «b»,​For I =​В этом макросе варианты​​ Но когда я​ = «=» ‘N2Z​Kak mozhno sdelat’​Insert — Module​​ результаты ОДНОЙ ГОНКИ.​​outchr = Eng(J)​ просто так не​ эту тему и​: Здравствуйте,​ такой макрос:​ S T U​ YA»)​ i, 1)​ аттаче.​ «v», «g», «d»,​ 1 To Len(Txt)​

​ замены русских букв​

planetaexcel.ru

Транслитерация. Сохранение форматирования текста

​ пытаюсь его изменить​​ .Forward = True​ transliteraцiju s sohraneniem​) и копируем туда​ Используя Макросы Excel​flag = 1​
​ запустите. Поэтому Aksima​ она размыта «в​Sergei Sonin​Option Explicit Function​ F KH TS​For i =​flag = 0​Файл удален​ «e», «e», «zh»,​с = Mid(Txt,​ английскими эквивалентами представлены​ или выполнить -​ .Wrap = wdFindContinue​ formatirovanija teksta?​ текст вот этих​ эту же задачу​Exit For​ дал Вам тестовую​ кирилицу», выкладываю вариант​, При обратной процедуре​ Translit$(iValue$) Dim iRussian$,​ CH SH SCH​ 1 To Len(txt)​For j =​- велик размер​ «z», «i», «y»,​ I, 1)​ согласно ГОСТ. Если​ пишет «Sub or​ .Format = False​111​ двух макросов:​ можно решить за​End If​ процедуру​ т/литерации UA-UK. Может​ я бы начал​ iCount%, iTranslit As​ » Y ‘​c = Mid(txt,​ 0 To 65​ — [​ «k», «l», «m»,​flag = 0​ для вашей задачи​ Function not defined»Макрос​ .MatchCase = False​Sasha_Smirnov​Sub Translate() Dim​ 5-10 минут.​

​Next J​​Sub Test​ кому пригодится:​ с сочетаний латинских​ Variant iRussian$ =​ E YU YA​
​ i, 1)​

​If RUS(j) =​​МОДЕРАТОРЫ​ «n», «o», «p»,​For J =​

​ нужны другие версии​​ для экселя. Ну​

​ .MatchWholeWord = False​​: Вот-вот!.. Да ещё​ cell1 as Range,​Как улучшить вышеуказанный​
​If flag Then​Теперь на нее​
​Function Translit(Txt As​
​ букв, имеющих наибольшую​ «АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя» iTranslit =​ a b v​
​flag = False​

​ c Then​​]​ «r», «s», «t»,​ 0 To 65​ (например, русская «я»​ и вставить это​ .MatchWildcards = False​ когда в начале​
​ cell2 As Range​
​ скрипт для следующей​ outstr = outstr​ и внимательно:​
​ String) As String​ длину.​ Array(«», «A», «B»,​ g d e​

​For j =​​outchr = Eng(j)​

​Михаил С.​​ «u», «f», «kh»,​If Rus(J) =​ должна выводиться как​ дело в​ .MatchSoundsLike = False​ Ж, Я и​ Dim i as​ базовой цели:​ & outchr Else​s = «АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя»​ ‘Запозичено з [url]http://www.moonexcel.ho.ua/[/url]​Например, так:​ «V», «G», «D»,​ zh z i​ 0 To 65​flag = 1​: Попробуйте еще раз​ «ts», «ch», «sh»,​ с Then​ «ja», а не​sub tt() end​ .MatchAllWordForms = False​ тому подобные дифтонги…​ Long, Langs As​Есть excel-документ. В​ outstr = outstr​ — в переменную​ _ index.php?page=tip_translit_ua ‘​Function Translit(ByVal sValue​ «E», «Jo», «Zh»,​ j k l​If RUS(j) =​Exit For​ и в формате​ «shch», «»», «y»,​outchr = Eng(J)​ как «ya» и​ subестественно нужно…​​ End With Selection.Find.Execute​​ (и кому это​
​ Long Langs =​ нём 4 листа​ & с​ загнали значение -​

​ дана функція виконує​​ As String) As​ «Z», «I», «Jj»,​ m n o​ c Then​End If​ 2003. Ваш файл​
​ «‘», «e», «yu»,​flag = 1​ т.д.), то можно​Hugo121​ Replace:=wdReplaceAll Selection.Find.Execute End​

​ нынче требуется, хотелось​​ 3 ‘количество языков​
​ («Лист1», «Мужчины», «Женщины»,​Next I​ русский алфавит (можете​ транслітерацію українських _​ String Dim sRussian​ «K», «L», «M»,​ p r s​outChr = Eng(j)​Next j​ не открывается. И​ «ya») s =​Exit For​ свободно подкорректировать это​, не, я говорю​ Sub​ бы знать!).​ перевода, включая русский​ «Флаги»). На Лист1​Translit = outstr​ заменить любой фразой​ букв латинськими (англ.)​ As String, iCount​ «N», «O», «P»,​ t u f​flag = True​If flag Then​ следите за размером​ Ячейка.Value For i​End If​ в теле макроса.​ про макрос​Yoooo​Как-как… инструментом Поиск-Замена!​ For Each cell1​ я ввёл фамилию​End Function​ русским языком). Потом​ Dim UkraineLang, EngLang​ As Integer, sTranslit​ «R», «S», «T»,​ kh ts ch​Exit For​ outstr = outstr​ (не более 100​ = LBound(sRussian) To​Next J​ Как легко догадаться,​shanemac51​: А если я​Иллюстрация: Макрос замены​ In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants) For​ биатлонистки «CHEVALIER ANAIS».​dimakdd​ вызывается функция, которой​ As Variant Dim​ As Variant sRussian​ «U», «F», «H»,​ sh sch »​End If​ & outchr Else​

​ кБ)​​ UBound(sRussian) s =​If flag Then​ два первых массива​.Скопировал эти буквы, вставил​ хочу заменить букву​
​ сокращений в MS​ Each cell2 In​ Нужно, чтобы Макрос​: Здравствуйте. Для сайта​ передают переменную s.​

​ i&, j&, curChr$,​​ = «АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя» sTranslit​
​ «C», «Ch», «Sh»,​ y ‘ e​Next j​ outstr = outstr​KuklP​ Replace(s, sRussian(i), sTranslit(i),​ outstr = outstr​ Rus и Eng​ в Excel. Не​ «ч» символом č,​ Word 2003.​ Worksheets(«Словарь»).Cells.SpecialCells(xlCellTypeConstants) If cell1.Value​ видел эту фамилию​ Википедия нужен скрипт.​ Здесь трудно сразу​ outchr$, outstr$, flag​ = Array(«», «A»,​ «Zch», «»», «‘Y»,​ yu ya JO​outStr = outStr​ & c​: Миш, привет. И​ , , vbBinaryCompare)​ & outchr Else​ как раз и​ снимая выделения, в​ или букву «ш»​Кстати, список замен​ = cell2.Value Then​ при том, что​ Требуется около 100​ обяснить, потому-что результат​ As Boolean UkraineLang​ «B», «V», «G»,​ «‘», «Eh», «Ju»,​ jo»)​ & IIf(flag, outChr,​Next i​ я загрузить не​ Next i ТРАНСЛИТ​ outstr = outstr​ кодируют эти подстановки.​ окне Immediate VBA​ символом š?​ оформляется также; вот​ i = cell2.Column​ «База данных» с​ фамилий биатлонистов «переделать»​ выводится в Immediate.​ = Array(«а», «б»,​ «D», «E», «Jo»,​ «Ja», «a», «b»,​out = Space(Len(txt)​ c)​Translit = outstr​ смог.​ = s End​ & с​Для новых версий Excel​ Код for each​

​Что тогда писать​​ испытанный пример: Форматирование​​ If i =​​ этой фамилией расположена​ с латиницы (и​ Но Вы можете,​ «в», «г», «д»,​
​ «Zh», «Z», «I»,​ «v», «g», «d»,​
​ * 3)​
​Next i​
​End Function​
​75070​
​ Function​
​Next I​
​ 2007-2010 и т.д.​
​ x in selection:debug.?​
​ в строке arrTranslit​ текста.​ Langs Then i​ на третьем листе​ не только) на​

​ после s= «AБ….»​​ «е», «є», «ж»,​ «Jj», «K», «L»,​
​ «e», «jo», «zh»,​For i =​
​Translit = outStr​Казанский​Михаил С.​II4eJI​

​Translit = outstr​​ не забудьте сохранить​ ascw(x):next 271 357​ = Array если​Hugo121​ = 1 Else​ (т.е. на листе​ кириллицу. Нужно именно​ дописать​ «з», «і», «ї»,​ «M», «N», «O»,​
​ «z», «i», «jj»,​ 1 To Len(txt)​End Function​: Дописал оболочку​: Привет!​: Здравсвуйте, есть вариант​End Function​ вашу книгу как​ 263 378 347​ там эти символы​
​: рисунок​ i = i​​ «Женщины»).​​ по принципу:​dim mNewString as​​ «й», «к», _​​ «P», «R», «S»,​ «k», «l», «m»,​j = AscW(Mid$(txt,​MCH​Function FamIO(s As​Игорь, файл то​ в экселе перевести​4. Сохранить.​ файл с поддержкой​

CyberForum.ru

​ 341 324 322​