Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

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

Предположим, что нам необходимо заменить все "ул." на листе на "улица ". Или русское слово "дом" на английское "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, 4 505 скачиваний)


Примечание: Я сделал файл как переводчик. Т.е. в первом столбце русские слова, во втором английские. Но в столбцах может быть что угодно - хоть слова, хоть символы, хоть числа.
На лист "Соответствия" записываете в столбец А - что заменять, в столбец В - на что заменять. Переходите на лист книги, в котором необходимо произвести замену. Выделяете ячейки, значения в которых надо найти и заменить. После чего жмете Alt+F8 и выбираете макрос "Tips_Macro_ReplaceMASS.xls!Replace_Mass"(или просто "Replace_Mass", если код в той же книге, что и ячейки для поиска и замены).
Первым появится окно с запросом направления перевода. По умолчанию 1(ru-en). Т.е. будет браться слово из столбца А и заменяться словом из столбца В. Но если указать 2 - то будет браться слово из столбца В и заменяться словом из столбца А. Т.е. аналог переводчика - с рус. на англ. и наоборот. Либо из А в В, либо из В в А.
Вторым появится запрос на метод просмотра данных:

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

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

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


и в итоге за пару секунд получим следующий результат:
Результат замены
Достаточно выделить столбец со статьями на листе с реализацией и запустить код(либо нажатием кнопки заменить значения, либо нажав 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 Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 38 комментариев
  1. Александр:

    Спасибо за код! Возникла проблема есть следующие соответствия
    К6 К7
    К7 К8
    К8 К9
    К9 К10
    на выходе все значения из левого столбца заменяются на К10, с обозначениями типа П1, В1 таких проблем нет.

    • Александр, скорее всего проблема именно в самих значениях. Это значит, что я не отвечу почему так происходит, не видя Ваших данных. Обратитесь в форум, опишите проблему и приложите файл. Тогда помочь будет проще.
      Кстати, проблема может быть в том, что в одни значения записаны с русской К, а другие - с английской.

  2. Григорий:

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

  3. Татьяна:

    День добрый! Попробовала воспользоваться - Run-time error 13: Type mismatch Debug

    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

    Что делать?

    • Добрый день.
      Советую проверить, нет ли в списке значений для замены значений ошибочных. На первый взгляд это единственная причина, по которой может произойти указанная ошибка. Код проверил - полностью рабочий, ошибок не выдает.

      • Татьяна:

        Какие значения считаются ошибочными?
        Посмотрите, пожалуйста, вот тут мой файл: https://www.dropbox.com/s/czic0v4aw1zoyxo/Tips_Macro_ReplaceMASS.xls?dl=0

        • Татьяна, в Вашем случае ошибка иная - кол-во символов в ячейках для замены превышает 255. А это ограничение Excel при замене из VBA методом Replace. Поэтому для Вашей ситуации надо менять код. Постараюсь выложить на днях другой вариант.

          • Татьяна:

            Оооо! Спасибо!

          • Пробуйте:

            Option Explicit
             
            Sub Replace_Mass()
                Dim s As String, ss As String
                Dim lCol As Long
                Dim avArr, arng, lrr As Long, lcc As Long, 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 'если значение для замены не пустое
                        If Len(s) < 255 And Len(avArr(lr, lToReplaceCol) & "") < 255 Then
                            Selection.Replace s, avArr(lr, lToReplaceCol), lLookAt
                        Else
                            arng = Selection.Value
                            If Not IsArray(arng) Then
                                ReDim arng(1 To 1, 1 To 1)
                                arng(1, 1) = Selection.Value
                            End If
                            For lrr = 1 To UBound(arng, 1)
                                For lcc = 1 To UBound(arng, 2)
                                    If Not IsError(arng(lrr, lcc)) Then
                                        arng(lrr, lcc) = Replace(arng(lrr, lcc), s, avArr(lr, lToReplaceCol), compare:=vbTextCompare)
                                    End If
                                Next
                            Next
                            Selection.Value = arng
                        End If
                    End If
                Next lr
                Application.ScreenUpdating = 1
            End Sub

            позже изменю код в самой статье. Спасибо за обнаруженный недочет.

      • Татьяна:

        Значение задано - только одно слово? Фраза не может быть?

  4. TipsyJr.:

    Подскажите пожалуйста! Что необходимо прописать в коде чтобы макрос учитывал регистр?

    • В этой строке:

      Selection.Replace s, avArr(lr, lToReplaceCol), lLookAt

      добавьте MatchCase:=True

      Selection.Replace s, avArr(lr, lToReplaceCol), lLookAt, MatchCase:=True
      • Konstantin:

        Добрый день! Скрипт хорош, но у меня отрабатывает со странной ошибкой, я проверяю верность замены путем разницы старого и замененного числа (если 0 то заменил верно), получается что скрипт отрабатывает вот так:
        2210000013360 2210000013377 17
        2210000013384 2210000013384 0
        2210000013384 2210000013391 7
        2210000013407 2210000013407 0
        2210000013407 2210000013414 7
        2210000013421 2210000013421 0
        2210000013438 2210000013438 0
        2210000013445 2210000013445 0
        2210000013445 2210000013452 7
        2210000013469 2210000013469 0
        2210000013469 2210000013476 7
        2210000013483 2210000013483 0
        2210000013483 2210000013490 7

        • Как правило все ошибки кодов связаны либо с неверным пониманием их работы и требованием от них того, что они не умеют, либо от их неверного применения. Какой Ваш случай - не возьмусь сказать, т.к. совершенно неясно из Вашего комментария что есть список замен и что и как заменяется. Например, почему первая строка должна была вообще замениться? Там два числа, которые вообще нигде не встречаются. В общем ничего не понял и дальше даже копаться не стал. Постарайтесь объяснить более развернуто.

  5. P0zitiv:

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

    (?=<p).*?(?) НА
    (?=<strong).*?(?) НА
    (?=<br).*?(?) НА
    (?=<b).*?(?) НА
    (?=<table).*?(?) НА
    (?=<td).*?(?) НА
    (?=<th).*?(?) НА
    (?=<li).*?(?) НА
    (?=<tr).*?(?) НА
    (?=<tbody).*?(?) НА
    (?=<h3).*?(?) НА
    (?=<ul).*?(?) НА

  6. Ирина:

    Дмитрий, добрый день!
    При работе с вашим макросом не можем заменить полностью значение, например если есть в ячейке значение "ENGINE ELECTR0NIC C0NTR0L SYSTEM SENS0R 1" то нужно поменять на "Датчики двигателя 1". Причем в ячейке может быть и другой текст, кроме заменяемого.

Поделитесь своим мнением

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


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти