Visits: 1083
Ставим задачу.
При получении данных из таблиц с помощью ВПР или ИНДЕКС важное значение имеет тип данных и языковая раскладка, с помощью которой набрано название. И если для смены типа можно использовать встроенные функции Excel, то с шрифтом все не так просто. По крайней мере, если решать задачу в лоб, то формула получится достаточно громоздкой.Давайте рассмотрим, как выполняется замена символов в VBA.
Давайте решим эту проблему, используя возможности 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
Отступы могут быть произвольными, можно вообще обойтись без них, но так проще отследить, что же происходит на участках кода
Где же применить полученный код? Лично я вижу два варианта.
Создаем пользовательскую функцию – UDF.
Первый – обернуть строки кода в виде функции. Например, создать пустой файл 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.
Теперь сохраним наш файл как надстройку 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 и выбрать нашу процедуру.
Замена символов в VBA произойдет автоматически во всех выделенный ячейках. И наконец ,если вам надо наоборот поменять русские буквы в латинице, то просто поменяйте местами в циклах 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 не такое уж сложное дело. Нужно только желание. Пробуйте, экспериментируйте. На этом все, встретимся на занятиях. Всем внимательности и упорства, а результат не заставит себя ждать.
