Курс MS Excel предназначен для всех кому необходимо работать с большим количеством данных и отчетов

Read more

Изучите все возможности PowerPoint по подготовке стильных современных презентаций

Read more

Microsoft Project предназначен помочь менеджеру проекта в разработке и отслеживании выполнения задач .


Замена английских символов на русский шрифт

Замена английских символов на русский шрифт одним щелчком, или  - боже, благослови VBA!

 При получении данных из таблиц с помощью ВПР или ИНДЕКС важное значение имеет тип данных и языковая раскладка, с помощью которой набрано название. И если для смены типа можно использовать встроенные функции Excel, то с шрифтом все не так просто. По крайней мере, если решать задачу в лоб, то формула получится достаточно громоздкой.

Давайте решим эту проблему, используя возможности VBA, или – проще – возможности макросов. Для этого вначале попробуем определить, какие именно знаки латинского алфавита похожи на русский и запишем их в виде строки

 

Получаем  такой код

Dim LatStr As String: LatStr = "EeOoPpAaXxCcMTHKB"

 

Как видим, таких знаков не так уж и много

Добавим соответствующие им символы кириллицы

Dim RusStr As String: RusStr = "ЕеОоРрАаХхСсМТНКВ"

 

Напоминаю, в первой строке все буквы латинские (английские, если вам так проще), а во второй – кириллица, то есть русские. Названия произвольны. Обратите внимание, что знаки, похожие по написанию, находятся на одинаковых местах. Логика тут следующая. Если один из знаков проверяемого текста совпадает с знаком из строки LatStr, то надо взять аналогичный знак из RusStr

Для этого назначим для проверяемой строки переменную TestString. К примеру, возьмем его из текущей ячейки

Dim TestString  as string: TestString=ActiveCell.Value

После этого начнем по очереди сравнивать каждый символ полученной строки с латиницей из LatStr.

Запускаем цикл для получения очередного знака из TestString.

Вначале объявим переменные хранения счетчиков циклов, а также очередных знаков из  TestString и LatStr. Так же зададим переменную типа строка для результата обработки NewString

 

Dim b as integer, J as integer, sValue as string, s1 as string, NewString as string

 

Запустим сам цикл

For j=1 to Len(TestString)

         sValue=Mid(TestString,j,1)

теперь начнем так же в цикле сравнивать его с знаками из LatStr. Если такой знак отыщется, то берем соответствующий знак из RusStr

For b=1 to Len(LatStr)

                         S1=mid(LatStr,b,1)

If  s1=SValue then SValue=Mid(RusStr,b,1)

Закрываем цикл сравнения и вернемся к проверке очередного знака.

Next b

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

 NewString=NewString & sValue

И закрываем цикл извлечения

Next j

В результате получили такой итоговый код

 

Dim TestString  as string: TestString=ActiveCell.Value

Dim LatStr As String: LatStr = "EeOoPpAaXxCcMTHKB"

Dim RusStr As String: RusStr = "ЕеОоРрАаХхСсМТНКВ"

Dim b as integer, J as integer, sValue as string, s1 as  string

For j=1 to Len(TestString)

         sValue=Mid(TestString,j,1)

For b=1 to len(LatStr)

                         S1=mid(LatStr,b,1)

If  s1=sValue then sValue=Mid(RusStr,b,1)

Next b

NewString=NewString & sValue

Next j

Отступы могут быть произвольными, можно вообще обойтись без них, но так проще отследить, что же происходит на участках кода

Где же применить полученный код? Лично я вижу два варианта.

Первый - обернуть строки кода в виде функции. Например, создать пустой файл Excel, открыть в нем редактор VBA, используя нажатие сочетания “Alt F11” и дать команду 

«Insert» → «module!»

 

В открывшемся окне надо вставить следующее

Public Function LatinToRus (TestString as Variant) as string

Редактор автоматически создаст основу или – как принято это называть – каркас для функции, добавив строку End Function. После этого добавим полученный нами выше код перед строкой End Function, но первую строку кода пропускаем – мы задаем TestString  как параметр – исходные данные – для нашей функции. Завершим все добавлением строки

LatinToRus=NewString

 

Результат получится таким

 

Public Function LatinToRus (TestString as Variant) as string

Dim LatStr As String: LatStr = "EeOoPpAaXxCcMTHKB"

Dim RusStr As String: RusStr = "ЕеОоРрАаХхСсМТНКВ"

Dim b as integer, J as integer, sValue as string, s1 as  string

For j=1 to Len(TestString)

         sValue=Mid(TestString,j,1)

For b=1 to len(LatStr)

                         S1=mid(LatStr,b,1)

If  s1=Svalue then Svalue=Mid(RusStr,b,1)

Next b

NewString=NewString & sValue

Next j

LatinToRus=NewString

End Function

 

Название функции естественно может быть произвольным

Теперь сохраним наш файл как надстройку Excel в формате Xlam. Excel сам автоматически выберет место для хранения надстройки, поэтому если вы хотите сохранить ее резервную копию, проще будет не искать ее, а дать команду «Сохранить как» ещё раз и сделать копию к примеру на рабочем столе

Теперь перейдем по пути

Файл → параметры → Надстройки → надстройки Excel → перейти

И отмечаем нашу надстройку флажком

После этого функция станет доступной во всех файлах  Excel для текущего пользователя в категории «Определенные пользователем»

 

А вот и пример использования.

Обратите  внимание на формулы. Очевидно, что после применения функции LatinToRus были найдены все слова по образцам

Второй способ примененияы – использование созданного кода в виде процедуры, например, для яеек выделения. Такую процедуру удобнее добавить в личную книгу макросов. Изначально доступ к ней запрерщен, поэтоиу пойдем на хитрость. Запустим запись макроса с вкладки «Вид»

Укажем хранение макроса в личной книге, после чего сразу остановим запись

Снова запускаем редактор VBA и открываем текст модуля из личной книги.

Удаляем строки Sub Макрос1 () и End Sub а так же все что Excel добавил между ними  и вставляем следующий код

Sub Change_Latin_To_Rus()

    Dim LatStr As String: LatStr = "EeOoPpAaXxCcMTHKB"

    Dim RusStr As String: RusStr = "ÅåÎîÐðÀàÕõÑñÌÒÍÊÂ"

    Dim b As Integer, J As Integer, sValue As String, s1 As String

    Dim TestString  As String

    For Each MyCells In Selection

        NewString = ""

        TestString = MyCells.Value

        For J = 1 To Len(TestString)

            sValue = Mid(TestString, J, 1)

            For b = 1 To Len(LatStr)

                s1 = Mid(LatStr, b, 1)

                If s1 = sValue Then sValue = Mid(RusStr, b, 1)

            Next b

            NewString = NewString & sValue

        Next J

        MyCells.Value = NewString

    Next MyCells

End Sub

Теперь достаточно выделить нужный диапазон, нажать сочетание Alt F8 и выбрать нашу процедуру

Замена произойдет автоматически во всех выделенный ячейках. И наконец ,если вам надо наоборот поменять русские буквы в латинице, то просто поменяйте местами в циклах LatStr и RusStr то есть сделайте так

For b=1 to len(RusStr)

S1=mid(RusStr,b,1)

If  s1=Svalue then Svalue=Mid(LatStr,b,1)

Next b

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

 

Категория: Обучение VBA | Добавил: Sergey_Haruk (28.12.2019)
Просмотров: 149 | Теги: работа с Excel, редактирование vba, Замена английских знаков, русские вместо латиницы, замена на русские | Рейтинг: 5.0/1
Всего комментариев: 0
Имя *:
Email *:
Код *: