Макрос для замены букв excel

Просмотров: 235

Ставим задачу.

 При получении данных из таблиц с помощью ВПР или ИНДЕКС важное значение имеет тип данных и языковая раскладка, с помощью которой набрано название. И если для смены типа можно использовать встроенные функции 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  не такое уж сложное дело. Нужно только желание. Пробуйте, экспериментируйте. На этом все, встретимся на занятиях. Всем внимательности и упорства, а результат не заставит себя ждать.

Транслит

Если Вам часто приходится переводить кириллицу в транслит (а попробуйте-ка сделать это для фамилии «Кржижановский», например), то эта функция — для Вас.

Откройте редактор Visual Basic (Alt+F11), вставьте через меню новый пустой программный модуль (Insert — Module) и скопируйте туда текст этой функции:

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

Теперь на любом листе этой книги Вы можете использовать эту функцию, вставив ее через Мастер Функций:

• в Excel 2003 и старше — через меню Вставка — Функция (Insert — Function)

• в Excel 2007 и новее — через вкладку Вставка — Функция (Insert — Function)

 из категории Определенные пользователем (User defined):

В этом макросе варианты замены русских букв английскими эквивалентами представлены согласно ГОСТ. Если для вашей задачи нужны другие версии (например, русская «я» должна выводиться как «ja», а не как «ya» и т.д.), то можно свободно подкорректировать это в теле макроса. Как легко догадаться, два первых массива Rus и Eng как раз и кодируют эти подстановки.

Для новых версий Excel 2007-2010 и т.д. не забудьте сохранить вашу книгу как файл с поддержкой макросов (Macro Enabled Workbook), т.е. в формате XLSM.

Ссылки по теме

• Макрос-переводчик
• Преобразование русского текста в транслит с помощью надстройки PLEX

Хитрости »

12 Август 2015              83697 просмотров

Массовая замена слов

Предположим, что нам необходимо заменить все «ул.» на листе на «улица «. Или русское слово «дом» на английское «house». Или еще интереснее: все английские буквы на русские. Например, английская «а» должна быть заменена на русскую «a», английская «c» на русскую «с», английская «H» на русскую «Н» и т.д. А такое тоже нередко бывает и доставляет проблемы. Ведь если в одной таблице будут русские буквы, а в другой английские — то применение большинства встроенных функций поиска(та же ВПР) просто не найдут соответствия.
Если подобную замену надо сделать для одного сочетания, то все просто: жмем Ctrl+H и указываем что заменить и на что. Но если таких замен надо сделать 20? Или 120? Это надо будет 120 раз нажать и ввести что заменять и на что. А если это надо сделать еще и не в одном документе — то…Думаю сами справитесь с умножением количества замен на количество файлов, в которых это надо сделать. И вроде бы простая операция превращается в ваш личный ад на работе.
Недавно на форуме участнику потребовалось автоматизировать именно такую штуку. Т.к. код несложный — решил написать и чуть дополнив выложить для всех кому код может потребоваться:

Option Explicit
Sub Replace_Mass()
    Dim s As String
    Dim lCol As Long
    Dim avArr, lr As Long
    Dim lLastR As Long
    Dim lToFindCol As Long, lToReplaceCol As Long, lLookAt As Long
 
    'запрашиваем направление перевода - с русского на англ. или наоборот
    lCol = Val(InputBox("Укажите направление перевода:" & vbNewLine & _
                    "   1 - ru-en" & vbNewLine & _
                    "   2 - en-ru", "Запрос", 1))
    If lCol = 0 Then Exit Sub
    'запрашиваем по части ячейки искать или по всему тексту
    'по умолчанию - по части
    lLookAt = Val(InputBox("Искать соответствие по части ячейки или по всему тексту:" & vbNewLine & _
                    "   1 - по всему тексту" & vbNewLine & _
                    "   2 - по части ячейки", "Запрос", 2))
    If lLookAt = 0 Then Exit Sub
 
    Select Case lCol
    Case 1
        lToFindCol = 1
        lToReplaceCol = 2
    Case 2
        lToFindCol = 2
        lToReplaceCol = 1
    End Select
 
    Application.ScreenUpdating = 0
    'Получаем с листа Соответствия значения, которые надо заменить в выделенном диапазоне
    With ThisWorkbook.Sheets("Соответствия")
        lLastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        avArr = .Cells(1, 1).Resize(lLastR, 2)
    End With
    'заменяем
    For lr = 1 To UBound(avArr, 1)
        s = avArr(lr, lToFindCol)
        If Len(s) Then 'если значение для замены не пустое
            Selection.Replace s, avArr(lr, lToReplaceCol), lLookAt
        End If
    Next lr
    Application.ScreenUpdating = 1
End Sub

Как это работает. В книге есть специальный лист с именем «Соответствия». На нем в столбце А записаны слова, которые необходимо заменить, а в столбце В — на что эти слова заменить. Если в столбце А пусто — то замена не будет произведена. Если в столбце В пусто — то значение из столбца А будет просто удалено.
Замены производятся исключительно в выделенных на листе ячейках. Ячейки могут быть несмежными.

Итак, необходимо сделать много замен. Скачиваете файл:

  Массовая замена слов (54,5 KiB, 9 783 скачиваний)

Примечание: Я сделал файл как переводчик. Т.е. в первом столбце русские слова, во втором английские. Но в столбцах может быть что угодно — хоть слова, хоть символы, хоть числа.

На лист «Соответствия» записываете в столбец А — что заменять, в столбец В — на что заменять. Переходите на лист книги, в котором необходимо произвести замену. Выделяете ячейки, значения в которых надо найти и заменить. После чего жмете Alt+F8 и выбираете макрос «Tips_Macro_ReplaceMASS.xls!Replace_Mass»(или просто «Replace_Mass», если код в той же книге, что и ячейки для поиска и замены).

Первым появится

окно с запросом направления перевода. По умолчанию 1(ru-en). Т.е. будет браться слово из столбца А и заменяться словом из столбца В. Но если указать 2 — то будет браться слово из столбца В и заменяться словом из столбца А. Т.е. аналог переводчика — с рус. на англ. и наоборот. Либо из А в В, либо из В в А.

Вторым появится

запрос на метод просмотра данных:

• если указать «1 — по всему тексту» — данные из столбца А будут заменять только в том случае, если ячейка в выделенном для замены диапазоне полностью совпадает со значением из столбца А листа «Соответствия». Например, в любой из выделенных ячеек записано «На столе книга», а на листе «Соответствия» в столбце А есть только слово «книга». Замена не будет произведена, т.к. необходимо, чтобы в столбце А было так же «На столе книга».
• если указать «2 — по части ячейки» — данные из столбца А будут заменять в случае, если ячейка в выделенном для замены диапазоне содержит любое слово из столбца А листа «Соответствия». На том же примере — «На столе книга». Если выбрать 2, то в тексте «На столе книга» слово книга будет заменено на слово из столбца В — «book».

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

Как видно, здесь присутствую только номера статей, но нет их расшифровки. Зато расшифровка есть в отдельном листе «Справочник»:

Как видно, в справочнике присутствуют нужные номера статей и можно было бы применить ту же ВПР(VLOOKUP) для замен. Если бы не одно но: в таблице по реализации помимо номеров статьей есть еще лишний текст «Статья затрат:». Конечно, можно сначала заменить этот текст, потом в отдельном столбце применить ВПР, заменить формулу значениями и вернуть в исходный столбец. Если при этом надо еще оставить текст «Статья затрат:», то надо будет сделать еще доп.манипуляции либо при составлении формулы, либо после. В любом случае — слишком много лишних телодвижений. А значит бОльшие времязатраты.
Приложенный ниже файл поможет сделать это в разы быстрее:

Скачать файл с примером и кодом:

  Массовая замена слов — статьи.xls (91,5 KiB, 2 648 скачиваний)

и в итоге за пару секунд получим следующий результат:

Достаточно выделить столбец со статьями на листе с реализацией и запустить код(либо нажатием кнопки заменить значения, либо нажав Alt+F8 и выбрав из списка макросов макрос

Replace_Mass

).
После нажатия на кнопку будут запрошены следующие параметры:

1. указать номер столбца значений в листе «Справочник», в котором искать соответствия номерам статей(в нашем случае это столбец 1(А))
2. указать номер столбца, значениями которого заменять найденные в таблице реализации значения(это может быть один из трех столбцов справочника: Группа затрат, Статья затрат, Подстатьи затрат). Логичнее всего указать столбец 4, т.к. он наиболее детализирован и конкретнее указывает расшифровку статьи
3. далее будет предложено указать точность поиска:
   • если указать «1 — по всему тексту» — данные будут заменены только в том случае, если значение ячейки в выделенном для замены диапазоне полностью совпадает со значением из столбца А листа «Справочник». Т.е. если бы у нас в таблице реализации был бы записан только номер статьи(1.01), тогда можно было бы указать именно 1
   • если указать «2 — по части ячейки» — данные будут заменены только в том случае, если значение ячейки в выделенном для замены диапазоне содержит любое значение из столбца А листа «Справочник». Это больше подходит к описанному случаю, т.к. нам необходимо заменить исключительно номер статьей на их расшифровку, оставив при этом текст «Статья затрат: «

Если все указано корректно, то на листе будут произведены все необходимые замены.
Возможные ошибки, которые предусмотрены кодом и о которых будет сообщено соответствующим сообщением(код прервется, замены не будут произведены):

• на листе Справочник нет значений
• в качестве столбца для поиска значений и для замены значений на листе Справочник указано одно и то же число
• в качестве столбца значений для замены указано число, превышающее общее количество столбцов на листе Справочник

Особое внимание хочу уделить случаю, когда выбирается замена по части ячейки. В этом случае лучше список на листе Справочник отсортировать по длине текста по тому столбцу, в котором будут значения для поиска. Зачем это надо: т.к. значение по части ячейки будет заменять не полное соответствие, то есть вероятность неверных замен. Например, есть текст «Статья затрат: 1.011». В то же время на листе Справочник есть статьи «1.01» и «1.011». Т.к. «1.01» идет раньше в большинстве случаев, то текст будет заменен некорректно: «Статья затрат: ТВ1«.
Чтобы получить длину строки текста можно использовать функцию ДЛСТР(LEN):
=ДЛСТР(A2)
=LEN(A2)

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

Так же см.:
Замена значений по списку в PowerQuery
Найти в ячейке любое слово из списка
Замена ссылок в формулах на их значения
Как удалить строки по условию?

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика