Как заменить русские буквы на английские в excel
Перейти к содержимому

Как заменить русские буквы на английские в excel

  • автор:

Как транслитерировать текст в Excel (русский текст преобразовать в английский транслит)

Очень часто требуется преобразовать русский текст (кириллицу) в английский (транслит), не перевести, а написать русские слова английскими буквами.

Такое, например, может понадобиться для импорта данных в какую-нибудь программу, базу данных, которая не поддерживает русские буквы. Задача распространенная, но стандартными средствами Excel не решается.

как преобразовать английй текст в транслит в Excel

Мы предлагаем вам два варианта решения данной задачи.

Первый способ транслитерировать русский текст

Первый способ транслита русского текста достаточно топорный — с использованием приложения Punto Switcher от Яндекс.

Скачиваем программу Punto Switcher на официальном сайте: http://punto.yandex.ru/

Punto Switcher — программа, которая автоматически переключает раскладку клавиатуры. Она знает, что «ghbdtn» — это «привет», а «пщщв ьщктштп» — это «good morning».

Так вот, данная программа, помимо своей основной функции можете переводить текст в транслит, менять регистр выделенного текста (сделать из «иванов» в «ИВАНОВ») и другое.

Устанавливаем программу себе на компьютер, в системном трее должен появится значок программы

punto-switcher

Если зайти в настройки (правой кнопкой мыши по значку, выбрать настройки, горячие клавиши), то можно увидеть, что по умолчанию установлено переводить текст в транслит с помощью горячих клавиш Alt+Scroll Lock

Горячие клавиши в Punto Switcher

К сожалению, в самом Excel программа транслитерировать текст не сможет, необходимо промежуточное действие. Копируем столбец с русскими буквами, открываем блокнот на компьютере (Notepad) и вставляем туда текст, далее выделяем текст в блокноте и нажимаем клавиши Alt+Scroll Lock, текст автоматически поменяется на транслит.

Далее вы просто копируете этот текст и вставляете обратно в Excel.

Это удобно если нужно например перевести в translit, например один объемный столбец данных на русском языке, но иногда преобразование текста в транслит требуется с помощью формул Excel, поэтому рассмотрим второй способ с использованием пользовательской функции Excel, написанной на VBA

Второй способ перевода русского текста в транслит в Excel с помощью пользовательской функции

Есть специальный макрос для создания пользовательской функции.

Function Translit(Txt As String) As String Dim Rus As Variant Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _ "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _ "щ", "ъ", "ы", "ь", "э", "ю", "я", "А", "Б", "В", "Г", "Д", "Е", _ "Ё", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р", _ "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я") Dim Eng As Variant Eng = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", _ "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", "JO", "ZH", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", _ "S", "T", "U", "F", "KH", "TS", "CH", "SH", "SCH", "''", "Y", "'", "E", "YU", "YA") For I = 1 To Len(Txt) с = Mid(Txt, I, 1) flag = 0 For J = 0 To 65 If Rus(J) = с Then outchr = Eng(J) flag = 1 Exit For End If Next J If flag Then outstr = outstr & outchr Else outstr = outstr & с Next I Translit = outstr End Function

Переключите раскладку на русский язык!! Копируем данный код, открываем среду VBA, для это нажмите правой кнопкой на активный лист и выберите пункт «Исходные данные«, либо нажмите Alt+F11 далее через меню выберите новый программный модуль (Insert — Module)

Открываем среду VBA для вставки кода

и в открывшееся окно вставляете данный код и закрываете это окно.

После этого в любом месте данного листа (а при вставке кода с помощью Insert — Module — в любом месте данной книги) вы сможете использовать пользовательскую функцию, которую можно вызвать выбрав:

Вставка — Функция ( Insert — Function )

в Excel 2013 Функция — Вставить функцию

Выбираем Категория: определенные пользователем, в данном списке должна появится наша функция Translit

функция транслит

Можно просто в нужной ячейке набрать =Transit(ссылка_на_русский_текст)

Как преобразовать тект в транслит - функция Excel

После этого протягиваем формулу и получаем нужный нам результат.

Если вы присмотритесь в полученный результат, то увидите, что данные немного отличаются, например

Ivanov Serge j Petrovich и Ivanov Serge y Petro vich

то есть буква «й» преобразовалась по-разному, если для вас это критично, то нужно будет немного поменять указанный выше код. В коде есть две таблицы — одна на русском языке, другая латиницей. Не трудно догадаться, что вам необходимо поменять нужные вам буквы. В данном случае в коде нужно найти «j» и поменять на «y», если требуется, то по аналогии поступаем с другими буквам.

  • Начиная с Excel 2007 не забудьте сохранить файл в формате поддержки макросов — xlsm, иначе макрос не сохранится;
  • Данный макрос необходимо вставлять в каждую отдельную книгу, в которой вы хотите, чтобы он работал;
  • Иногда требуется, чтобы была не встроенная функция, а макрос при запуске которого текст будет переводится в транслит, в этом случае нужно вставить код, указанный ниже. В итоге, для перевода текста в transit необходимо выделить нужный текст на русском языке (диапазон ячеек) и запустить макрос «Translit» и данный текст будет обработан.
  • Важно! Перед копированием данного кода, обязательно переключите раскладку клавиатуры на русский язык.
Sub Translit() Dim Txt As Variant Dim i As Integer Dim J As Integer Dim c As String Dim flag As Integer Dim outchr As String Dim outstr As String Dim Rus As Variant Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _ "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _ "щ", "ъ", "ы", "ь", "э", "ю", "я", "А", "Б", "В", "Г", "Д", "Е", _ "Ё", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р", _ "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я") Dim Eng As Variant Eng = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", _ "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", "JO", "ZH", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", _ "S", "T", "U", "F", "KH", "TS", "CH", "SH", "SCH", "''", "Y", "'", "E", "YU", "YA") For Each Txt In Selection.Cells outstr = Empty For i = 1 To Len(Txt) с = Mid(Txt, i, 1) flag = 0 For J = 0 To 65 If Rus(J) = с Then outchr = Eng(J) flag = 1 Exit For End If Next J If flag Then outstr = outstr & outchr Else outstr = outstr & с Next i Txt.Value = outstr Next Txt End Sub

Итак, надеюсь вы нашли ответ на свой вопрос о том, как проще всего транслитерировать текст в Excel (преобразовать текст на русском языке в транслит).

Ставьте лайки, подписывайтесь на наши группы в социальных сетях и следите за следующими уроками.

SirExcel — безграничные возможности Excel

Как правильно настроить поиск и замену английских букв в русском тексте таблиц Excel

Одна из типовых ситуаций, с которой все мы однажды сталкиваемся, выглядит так: кто-то при наборе текстовой информации в ячейку случайно использовал английские буквы (латиницу) вместо русских (кириллицы). Допустить такую ошибку легко даже самим, особенно если учесть изощренное расположение некоторых символов (русская «С» и английская «С», например) в стандартной раскладке клавиатуры.

Использование символов латиницы в русском тексте порождает огромное количество проблем. От путаницы при банальной сортировке по алфавиту до некорректной консолидации данных при автоматическом объединении нескольких таблиц в одну. Выискивать похожие по виду символы и проверять, не являются ли они символами английской раскладки, крайне мучительно. Поэтому имеет смысл рассмотреть более изящные варианты решения этой задачи.

Способ 1. Шрифт без кириллицы

Выделите диапазон ячеек с проверяемым текстом и временно установите для него любой шрифт, не содержащий кириллицу, например Albertus, Bauhaus93 или любой аналогичный (находится методом перебора). Внешний вид символов кириллицы и латиницы станет отличаться, и можно будет легко визуально локализовать некорректные символы.

Шрифт без кириллицы

Шрифт без кириллицы

Способ 2. Подсветка латиницы красным цветом шрифта

Этот способ является продолжением и развитием предыдущей идеи и заключается в изменении цвета символов латиницы на красный с помощью небольшого макроса. Откройте редактор Visual Basic сочетанием клавиш Alt+F11, вставьте новый модуль (меню Insert – Module) и введите туда следующий код.

1 2 3 4 5 6 7 8 9 10
Sub ShowLatinRed() For Each c In Selection For i = 1 To Len(c) If (Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) Or _ (Asc(Mid(c, i, 1)) >= 97 And Asc(Mid(c, i, 1)) Then c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3 End If Next i Next c End Sub

Sub ShowLatinRed() For Each c In Selection For i = 1 To Len(c) If (Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) = 97 And Asc(Mid(c, i, 1))

Теперь если выделить интересующий диапазон ячеек и запустить наш макрос с помощью сочетания клавиш Alt+F8 или через вкладку Разработчик → Макросы (Developer → Macros), то символы латиницы выделятся красным цветом шрифта.

Символы латиницы выделятся красным цветом

Символы латиницы выделятся красным цветом

Выделяйте только ячейки с текстом, а не весь столбец листа – это больше миллиона пустых ячеек, перебирать которые макрос будет долго.

Способ 3. Функция IsLatin на VBA

Если количество проверяемых ячеек велико, то визуальное определение станет затруднительным. Для таких случаев можно создать пользовательскую функцию (назовем ее, например, IsLatin), которая будет проверять, присутствуют ли в заданной ячейке символы английского алфавита, и выдавать в качестве результата логическое значение ИСТИНА или ЛОЖЬ.

Откройте редактор Visual Basic сочетанием клавиш Alt+F11, вставьте новый модуль (меню Insert → Module) и введите туда текст этой небольшой функции.

1 2 3 4 5 6 7 8 9
Function IsLatin(str As String) as Boolean str = LCase(str) LatinAlphbet = "*[abcdefghijklmnopqrstuvwxyz]*" If str Like LatinAlphbet Then IsLatin = True Else IsLatin = False End If End Function

Function IsLatin(str As String) as Boolean str = LCase(str) LatinAlphbet = «*[abcdefghijklmnopqrstuvwxyz]*» If str Like LatinAlphbet Then IsLatin = True Else IsLatin = False End If End Function

Как можно заметить, макрофункция использует интересный оператор Like языка Visual Basic, который проверяет наличие в исходном тексте любых символов из английского алфавита, предварительно преобразовав текст в нижний регистр с помощью функции LCase.

Теперь в Мастере функций в категории Определенные пользователем (User Defined) можно найти нашу функцию IsLatin и воспользоваться ею. Функция выдаст значение ИСТИНА (TRUE), если найдет в тексте аргумента хотя бы один символ латиницы. В противном случае функция вернет значение ЛОЖЬ (FALSE).

Функция выдаст значение ИСТИНА или ЛОЖЬ

Функция выдаст значение ИСТИНА или ЛОЖЬ

Замена латиницы на кириллицу

Если необходимо не просто обнаружить чужеродные английские буквы в русском массиве текста, а исправить символы латиницы на соответствующую им кириллицу, можно быстро сделать это с помощью макроса. Откройте редактор Visual Basic сочетанием клавиш Alt+F11, вставьте новый модуль (меню Insert → Module) и введите туда его текст.

1 2 3 4 5 6 7 8 9 10 11 12 13
Sub Replace_Latin_to_Russian() Rus = "асекорхуАСЕНКМОРТХ" Eng = "acekopxyACEHKMOPTX" For Each cell In Selection For i = 1 To Len(cell) c1 = Mid(cell, i, 1) If c1 Like "[" & Eng & "]" Then c2 = Mid(Rus, InStr(1, Eng, c1), 1) cell.Value = Replace(cell, c1, c2) End If Next i Next cell End Sub

Sub Replace_Latin_to_Russian() Rus = «асекорхуАСЕНКМОРТХ» Eng = «acekopxyACEHKMOPTX» For Each cell In Selection For i = 1 To Len(cell) c1 = Mid(cell, i, 1) If c1 Like «[» & Eng & «]» Then c2 = Mid(Rus, InStr(1, Eng, c1), 1) cell.Value = Replace(cell, c1, c2) End If Next i Next cell End Sub

Теперь если выделить на листе диапазон и запустить наш макрос сочетанием клавиш Alt+F8 или на вкладке Разработчик → Макросы (Developer → Macros), то все английские буквы, найденные в выделенных ячейках, будут заменены на равноценные им русские. Только будьте осторожны, чтобы не заменить случайно нужную вам латиницу.

Как заменить русские буквы на английские в excel

Доброго времени суток!

Подскажите пожалуйста, есть столбец с цифрами и буквами типа “00566СDН” или “LGО” где буквы C, О, H могут быть как Русскими так и английскими, можно желательно формулами или макросами в соседние 2 столбца вывести варианты, первый столбец все похожие буквы заменить на английские, во втором столбце все похожие буквы заменить на русские. Может темы были уже помогите пожалуйста?

Доброго времени суток!

Подскажите пожалуйста, есть столбец с цифрами и буквами типа “00566СDН” или “LGО” где буквы C, О, H могут быть как Русскими так и английскими, можно желательно формулами или макросами в соседние 2 столбца вывести варианты, первый столбец все похожие буквы заменить на английские, во втором столбце все похожие буквы заменить на русские. Может темы были уже помогите пожалуйста? dfysdbu

К сообщению приложен файл: 6789061.xlsx (8.0 Kb)

Сообщение Доброго времени суток!

Подскажите пожалуйста, есть столбец с цифрами и буквами типа “00566СDН” или “LGО” где буквы C, О, H могут быть как Русскими так и английскими, можно желательно формулами или макросами в соседние 2 столбца вывести варианты, первый столбец все похожие буквы заменить на английские, во втором столбце все похожие буквы заменить на русские. Может темы были уже помогите пожалуйста? Автор — dfysdbu
Дата добавления — 10.09.2014 в 18:38

Группа: Друзья
Ранг: Экселист
Сообщений: 8769
Замечаний: 0% ±

Excel 2010
=ПОДСТАВИТЬ()
=ПОДСТАВИТЬ()
=ПОДСТАВИТЬ()
~12 раз Автор — Nic70y
Дата добавления — 10.09.2014 в 20:25
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Замечаний: 0% ±

Excel 2013

Подскажите пожалуйста, как эту функцию в одну формулу объединить? непойму

Подскажите пожалуйста, как эту функцию в одну формулу объединить? непойму dfysdbu

Подскажите пожалуйста, как эту функцию в одну формулу объединить? непойму Автор — dfysdbu
Дата добавления — 10.09.2014 в 20:58

Группа: Друзья
Ранг: Экселист
Сообщений: 8769
Замечаний: 0% ±

Excel 2010
К сообщению приложен файл: 15.42.xlsx (8.4 Kb)
Автор — Nic70y
Дата добавления — 10.09.2014 в 21:06
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3209
Замечаний: 0% ±

2003

Давно уже сделал (и, кажется, здесь это уже выкладывал в «Готовых решениях») пару макросов для борьбы с «трудами плодов» паразитов, которым лень переключать раскладку клавиатуры для ввода одинаковых на взгляд букв латиницы и кириллицы

Sub Repair_RUS() ‘ заменить в не скрытых ячейках выделенного диапазона латинские буквы такими же по начертанию русскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim LATChr$: LATChr = «CcEeTOopPAaHKkXxBM»
Dim RUSChr$: RUSChr = «СсЕеТОорРАаНКкХхВМ»
Dim i%
For i = 1 To Len(LATChr)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=Mid(LATChr, i, 1), Replacement:=Mid(RUSChr, i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

И в обратную сторону:

Sub Repair_LAT() ‘ заменить в не скрытых ячейках выделенного диапазона русские буквы такими же по начертанию латинскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim arrENG: arrENG = Split(«C c E e T O o p P A a H K k X x B M»)
Dim arrRUS: arrRUS = Split(«С с Е е Т О о р Р А а Н К к Х х В М»)
Dim i%
For i = 0 To UBound(arrENG)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=arrRUS(i), Replacement:=arrENG(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Давно уже сделал (и, кажется, здесь это уже выкладывал в «Готовых решениях») пару макросов для борьбы с «трудами плодов» паразитов, которым лень переключать раскладку клавиатуры для ввода одинаковых на взгляд букв латиницы и кириллицы

Sub Repair_RUS() ‘ заменить в не скрытых ячейках выделенного диапазона латинские буквы такими же по начертанию русскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim LATChr$: LATChr = «CcEeTOopPAaHKkXxBM»
Dim RUSChr$: RUSChr = «СсЕеТОорРАаНКкХхВМ»
Dim i%
For i = 1 To Len(LATChr)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=Mid(LATChr, i, 1), Replacement:=Mid(RUSChr, i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

И в обратную сторону:

Sub Repair_LAT() ‘ заменить в не скрытых ячейках выделенного диапазона русские буквы такими же по начертанию латинскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim arrENG: arrENG = Split(«C c E e T O o p P A a H K k X x B M»)
Dim arrRUS: arrRUS = Split(«С с Е е Т О о р Р А а Н К к Х х В М»)
Dim i%
For i = 0 To UBound(arrENG)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=arrRUS(i), Replacement:=arrENG(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

С уважением,
Алексей
MS Excel 2003 — the best.

Сообщение отредактировал Alex_ST — Среда, 10.09.2014, 22:41

Сообщение Давно уже сделал (и, кажется, здесь это уже выкладывал в «Готовых решениях») пару макросов для борьбы с «трудами плодов» паразитов, которым лень переключать раскладку клавиатуры для ввода одинаковых на взгляд букв латиницы и кириллицы

Sub Repair_RUS() ‘ заменить в не скрытых ячейках выделенного диапазона латинские буквы такими же по начертанию русскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim LATChr$: LATChr = «CcEeTOopPAaHKkXxBM»
Dim RUSChr$: RUSChr = «СсЕеТОорРАаНКкХхВМ»
Dim i%
For i = 1 To Len(LATChr)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=Mid(LATChr, i, 1), Replacement:=Mid(RUSChr, i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

И в обратную сторону:

Sub Repair_LAT() ‘ заменить в не скрытых ячейках выделенного диапазона русские буквы такими же по начертанию латинскими
With ActiveSheet.UsedRange
If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
Dim arrENG: arrENG = Split(«C c E e T O o p P A a H K k X x B M»)
Dim arrRUS: arrRUS = Split(«С с Е е Т О о р Р А а Н К к Х х В М»)
Dim i%
For i = 0 To UBound(arrENG)
Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
What:=arrRUS(i), Replacement:=arrENG(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Как заменить русские буквы на английские в excel

Добрый день!
Подскажите пожалуйста, как в файле excel найти символы, набранные при русской раскладке клавиатуры, и заменить их на соответствующие английские символы (например С-C, Р-P, Н-H, .-. и т.д.).

Пользователь
Сообщений: 11312 Регистрация: 01.01.1970
26.04.2011 10:09:43

Ctrl+H
найти С (английскую)
заменить С (русская)

Пользователь
Сообщений: 14868 Регистрация: 21.12.2012
E-mail и реквизиты в профиле.
26.04.2011 10:10:27

Было.
Sub ChangeEngRus_CcEeTOopPAaHKkXxBM()
Dim c As Object
Dim n As Integer, i As Integer, posChar As Integer
Dim ToRusLang As Boolean
Dim LineChars(1) As String * 72
Dim Ch As String * 1
Dim TempSelection As String
LineChars(0) = «CcEeTOopPAaHKkXxBM»
LineChars(1) = «СсЕеТОорРАаНКкХхВМ»
For Each c In Selection.Cells
TempSelection = c.Value
ToRusLang = True
For i = 1 To Len(TempSelection)
Ch = Mid(TempSelection, i, 1)
If ToRusLang Then n = 0 Else n = 1
posChar = InStr(LineChars(n), Ch)
If posChar = 0 Then
n = 0 ‘Abs(n — 1)
posChar = InStr(LineChars(n), Ch)
End If
If posChar <> 0 Then
Select Case n
Case 0
ToRusLang = True
Case 1
ToRusLang = False
End Select
Mid(TempSelection, i, 1) = Mid(LineChars(Abs(n — 1)), posChar, 1)
End If
Next
c.Value = TempSelection
Next c
End Sub

Я сам — дурнее всякого примера! .
Пользователь
Сообщений: 2765 Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
26.04.2011 10:15:26

Выбирайте, как вам больше нравится:
Sub Repair_RUS() ‘ заменить латинские буквы такими же по начертанию русскими
If TypeName(Selection) <> «Range» Then Exit Sub
Dim LATChr$: LATChr = «CcEeTOopPAaHKkXxBM»
Dim RUSChr$: RUSChr = «СсЕеТОорРАаНКкХхВМ»
Dim i%
For i = 1 To Len(LATChr)
Intersect(Selection, ActiveSheet.UsedRange).Replace _
What:=Mid(LATChr, i, 1), _
Replacement:=Mid(RUSChr, i, 1), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End Sub
Sub Repair_LAT() ‘ заменить русские буквы такими же по начертанию латинскими
If TypeName(Selection) <> «Range» Then Exit Sub
Dim arrENG(): arrENG = Array(«C», «c», «E», «e», «T», «O», «o», «p», «P», «A», «a», «H», «K», «k», «X», «x», «B», «M»)
Dim arrRUS(): arrRUS = Array(«С», «с», «Е», «е», «Т», «О», «о», «р», «Р», «А», «а», «Н», «К», «к», «Х», «х», «В», «М»)
Dim i%
For i = 0 To UBound(arrENG)
Intersect(Selection, ActiveSheet.UsedRange).Replace _
What:=arrRUS(i), _
Replacement:=arrENG(i), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End Sub

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST. )
26.04.2011 10:15:52

данная программа производит именно ЗАМЕНУ русских символов английскими?
обращает ли она внимание на такие символы, как точка, запятая и т.д. ?

Пользователь
Сообщений: 2765 Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
26.04.2011 10:19:51
А у вас запятая на русской раскладке разве не такая же, как на английской. 🙂
С уважением, Алексей (ИМХО: Excel-2003 — THE BEST. )
Пользователь
Сообщений: 14868 Регистрация: 21.12.2012
E-mail и реквизиты в профиле.
26.04.2011 10:29:54

Чтоб меняла с русского на английский, нужно поменять местами 2 цифры так:
LineChars(1) = «CcEeTOopPAaHKkXxBM»
LineChars(0) = «СсЕеТОорРАаНКкХхВМ»

Я сам — дурнее всякого примера! .
26.04.2011 10:37:17

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

Пользователь
Сообщений: 169 Регистрация: 01.01.1970
26.04.2011 10:38:38
26.04.2011 10:52:38
Премного благодарен!
Пользователь
Сообщений: 2765 Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
26.04.2011 10:58:32

А какой из макросов вы решили заюзать?
Один из двух, приведённых мною или тот, что выложил Сергей (KukLP)?

Ну и, раз у вас возникают проблемы с некоторыми раздолбаями, которым лень переключить раскладку при необходимости ввода одинаковых «на взгляд» символов, то могу подкинуть «до кучи» ещё и макрос, который цветом выделяет латинские и русские буквы:

Sub Color_RUS_LAT() ‘ Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские — КРАСНЫМ
If TypeName(Selection) <> «Range» Then Exit Sub
Dim iCell As Range, rRange As Range, i%, ASCII%, iColor%
On Error GoTo eXXit
Set rRange = Intersect(Selection, ActiveSheet.UsedRange)
If rRange Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each iCell In rRange
For i = 1 To Len(iCell)
ASCII = Asc(Mid(iCell, i, 1))
If (ASCII >= 192 And ASCII If (ASCII >= 65 And ASCII = 97 And ASCII iCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
Next i
Next iCell
rRange.Select
Application.ScreenUpdating = True
eXXit: End Sub

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *