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

Замена подстроки, содержащейся в текстовых значениях ячеек указанного диапазона, другой подстрокой с помощью метода Range.Replace из кода VBA Excel.

Range.Replace – это метод, который находит по шаблону подстроку в содержимом ячеек указанного диапазона, заменяет ее на другую подстроку и возвращает значение типа Boolean.

Метод имеет некоторые особенности, которые заключаются в следующем:

при присвоении булева значения, возвращаемого методом Range.Replace, переменной, необходимо список параметров (аргументов) метода заключать в круглые скобки;
если метод используется без присвоения возвращаемого значения переменной, параметры должны быть указаны без заключения их в круглые скобки.

Синтаксис и параметры метода

Синтаксис

Синтаксис при замене подстроки и присвоении переменной возвращаемого значения типа Boolean:

variable = expression.Replace(What, Replacement, [LookAt], [SearchOrder], [MatchCase], [MatchByte], [SearchFormat], [ReplaceFormat])

Синтаксис при замене подстроки без присвоения переменной возвращаемого значения:

expression.Replace What, Replacement, [LookAt], [SearchOrder], [MatchCase], [MatchByte], [SearchFormat], [ReplaceFormat]

variable – переменная (тип данных — Boolean);
expression – выражение, возвращающее объект Range.

Параметры

Параметр	Описание
What	Искомая подстрока или шаблон*, по которому ищется подстрока в диапазоне ячеек. Обязательный параметр.
Replacement	Подстрока, заменяющая искомую подстроку. Обязательный параметр.
LookAt	Указывает правило поиска по полному или частичному вхождению искомой подстроки в текст ячейки: 1 (xlWhole) – поиск полного вхождения искомого текста; 2 (xlPart) – поиск частичного вхождения искомого текста. Необязательный параметр.
SearchOrder	Задает построчный или постолбцовый поиск: 1 (xlByRows) – построчный поиск; 2 (xlByColumns) – постолбцовый поиск. Необязательный параметр.
MatchCase	Поиск с учетом или без учета регистра: 0 (False) – поиск без учета регистра; 1 (True) – поиск с учетом регистра. Необязательный параметр.
MatchByte	Способы сравнения двухбайтовых символов: 0 (False) – двухбайтовые символы сопоставляются с однобайтовыми эквивалентами; 1 (True) – двухбайтовые символы сопоставляются только с двухбайтовым символами. Необязательный параметр.
SearchFormat	Формат поиска. Необязательный параметр.
ReplaceFormat	Формат замены. Необязательный параметр.

* Смотрите знаки подстановки для шаблонов, которые можно использовать в параметре What.

Работа метода в VBA Excel

Исходная таблица для всех примеров:

Пример 1

Примеры записи строк кода с методом Range.Replace и поиском по частичному совпадению подстроки с содержимым ячейки:

Sub Primer1()

‘Запись 1:

Range(«A1:C6»).Replace «Лиса», «Рысь», 2

‘Запись 2:

Range(«A1:C6»).Replace What:=«Лиса», Replacement:=«Рысь», LookAt:=2

‘Запись 3:

If Range(«A1:C6»).Replace(«Лиса», «Рысь», 2) Then

End If

‘Запись 4:

Dim a

a = Range(«A1:C6»).Replace(«Лиса», «Рысь», 2)

End Sub

Результат выполнения любого из вариантов кода примера 1:

Пример 2

Поиск по шаблону с использованием знаков подстановки и по полному совпадению подстроки с содержимым ячейки:

Sub Primer2()

Range(«A1:C6»).Replace «Ли??», «Рысь», 1

End Sub

Обратите внимание, что слово «Лиса» заменено словом «Рысь» не во всех ячейках. Это произошло из-за того, что мы использовали параметр LookAt:=1 – поиск полного вхождения искомого текста в содержимое ячейки.

Источник

Хитрости »

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

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

Предположим, что нам необходимо заменить все «ул.» на листе на «улица «. Или русское слово «дом» на английское «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(А))
указать номер столбца, значениями которого заменять найденные в таблице реализации значения(это может быть один из трех столбцов справочника: Группа затрат, Статья затрат, Подстатьи затрат). Логичнее всего указать столбец 4, т.к. он наиболее детализирован и конкретнее указывает расшифровку статьи
далее будет предложено указать точность поиска:
- если указать «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
ссылки
статистика

Источник

argyman

Пользователь

Сообщений: 45
Регистрация: 20.04.2015

Добрый день!

Прошу Вашей помощи!
В примере есть лист 1 — Specification, в первом столбце(его положение может меняться, поэтому лучше использовать выделенный диапазон) слова с ошибками, в них нужно исправить ошибки с помощью замены, из листа 2 — ReplaceList, в нём два столбца, в первом слова с ошибками, во втором правильный, он будет постоянно дополняться.

Нужен макрос, который бы находил и заменял текст в выделенном диапазоне ячеек согласно списку, объем достаточно большой от 2 500 до 10 000 ячеек.

Буду очень благодарен за помощь!

Спасибо!

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

24.08.2018 14:22:50

argyman, вот вариант:

Код

Sub replaceByList()
    Dim replaceRn As Range, inputRn As Range, replacementsRn As Range
    ' Определяем диапазон со значениями для замен
    With ThisWorkbook.Sheets("ReplaceList")
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
    End With
    With ThisWorkbook.Sheets("Specification")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error goto 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
    Next rrow
    
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

Прикрепленные файлы

ReplaceMacros.xlsm (18.35 КБ)

Изменено: tolstak — 24.08.2018 14:24:14

In GoTo we trust

Nordheim

Пользователь

Сообщений: 3154
Регистрация: 18.04.2017

24.08.2018 14:39:30

Еще вариант:

Код

Option Explicit

Sub test()
    Dim dic As Object, txt$
    Dim i&, arr()
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Worksheets("ReplaceList").UsedRange.Value
    For i = 1 To UBound(arr)
        txt = arr(i, 1)
        dic.Item(txt) = arr(i, 2)
    Next i
    arr = Worksheets("Specification").UsedRange.Value
    For i = 1 To UBound(arr)
        txt = arr(i, 1)
        If dic.exists(txt) Then arr(i, 1) = dic.Item(txt)
    Next i
    Worksheets("Specification").[a1].Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub

«Все гениальное просто, а все простое гениально!!!»

argyman Пользователь Сообщений: 45 Регистрация: 20.04.2015	tolstak, огромное Вам спасибо! Отличное решение! Именно то, что я и хотел!

Nordheim

Пользователь

Сообщений: 3154
Регистрация: 18.04.2017

24.08.2018 15:08:17

Пример с выбором диапазона:

Код

Sub test()
'   ---------------------------------------------
    Dim dic As Object, i&, txt$
    Dim allrange As Range, rng As Range
'   ---------------------------------------------
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    Set allrange = Application.InputBox("Выберите диапазон", Type:=8)
    arr = Worksheets("ReplaceList").UsedRange.Value
    For i = 1 To UBound(arr)
        txt = arr(i, 1)
        dic.Item(txt) = arr(i, 2)
    Next i
    For Each rng In allrange
        txt = rng.Value
        If dic.exists(txt) Then rng.Value = dic.Item(txt)
    Next rng
    Application.ScreenUpdating = True
End Sub

«Все гениальное просто, а все простое гениально!!!»

argyman Пользователь Сообщений: 45 Регистрация: 20.04.2015	Nordheim, круто! спасибо большое!

AngSem Пользователь Сообщений: 1 Регистрация: 03.06.2019	А как можно дополнить данный код, чтобы рядом с таблицей значений на замену была таблица со значениями, при встрече которых строка бы удалялась полностью?

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

10.06.2019 14:08:05

AngSem, можно вот так:

Код

Sub replaceByList()
    Dim replaceRn As Range, inputRn As Range, replacementsRn As Range
    Dim deletionRn As Range, delRn As Range
    
    ' Определяем диапазон со значениями для удаления и замен
    With ThisWorkbook.Sheets("ReplaceList")
        ' Значения для удаления
        Set deletionRn = Range(.Cells(2, 5), .Cells(.Rows.Count, 5).End(xlUp).Offset(0, 1))
        
        ' Значения для замены
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
    End With
    
    With ThisWorkbook.Sheets("Specification")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error GoTo 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
' Поиск строк для УДАЛЕНИЯ
' Если удаление не требуется, кусок можно закомментировать
    ' Для каждой строки в анализируемых данных
    For Each ccell In inputRn.Cells
        ' Если ВПР(текущее значение;список_на_удаление;1;0) находит что-то, то
        If Not IsError(Application.VLookup(ccell.Cells(1).Value, deletionRn, 1, 0)) Then
            ' Добавим текущую строку к диапазону на удаление
            If delRn Is Nothing Then
                Set delRn = ccell.EntireRow
            ' Если в диапазоне на удаление уже что-то есть - допишем в него текущую строку
            Else
                Set delRn = Union(delRn, ccell.EntireRow)
            End If
        End If
    Next ccell
    ' Удалим диапазон, если он не пустой
    If Not delRn Is Nothing Then delRn.Delete
''
    
    
' Поиск строк для ЗАМЕНЫ
' Если удаление не требуется, кусок можно закомментировать
    
    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
    Next rrow
''
    
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

Прикрепленные файлы

ReplaceMacros.xlsm (21.07 КБ)

In GoTo we trust

Andrey K

Пользователь

Сообщений: 2
Регистрация: 12.06.2020

Вопрос к tolstak, а как в первом варианте сделать так чтобы значения в ячейках которые проверяются были жестко зафиксированы.
то есть в файле спецификации есть и aakrp и aakr и aakr45

при нынешней обработке получается что aakrp и aakr45 преобразовываются в значение которое подставляется по синтаксису aakr с концом от значения в виде P и 45
как залочить значения? что если в ячейке aakr45 то оно и будет менятся на то чему равно в спецификации.

Изменено: Andrey K — 12.06.2020 18:52:13

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

#10

12.06.2020 18:57:53

Andrey K, по идее, вот так:

Код

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value, LookAt:=xlWhole
    Next rrow

Прикрепленные файлы

ReplaceMacros.xlsm (18.85 КБ)

In GoTo we trust

Andrey K Пользователь Сообщений: 2 Регистрация: 12.06.2020	tolstak,Спасибо большое всё помогло! =) дальше уже сам доделал обратное объединение в строку.

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019	Вопрос к tolstak, а как в первом варианте делать замену и по условию: т.е если значение ячейки не начинается на Liftinq или на Antistat то замену выполняем , в противном случае оставляем значение ячейки без изменений

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

#13

22.07.2020 08:42:41

ageres1982, вот так:

Код

Sub replaceByList()
    Dim replaceRn As Range, inputRn As Range, replacementsRn As Range
    ' Определяем диапазон со значениями для замен
    With ThisWorkbook.Sheets("ReplaceList")
        ' Фразы для замены
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
        ' Если ячейка начинается на эти слова - не делаем замену
        Set startingWordsToIgnoreRn = Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    
    With ThisWorkbook.Sheets("Specification")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error GoTo 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True
        ' Проверяем наличие слов из списка
        For Each wordRn In startingWordsToIgnoreRn
            word = wordRn.Value
            If Left(rrow.Cells(1, 1).Value, Len(word)) = word Then
                proceed = False
                Exit For
            End If
        Next wordRn
        
        ' Если нет слов из списка - начинаем замену.
        If proceed Then
            replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
        End If
    Next rrow
    
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

Прикрепленные файлы

ReplaceMacros (1).xlsm (20.91 КБ)

In GoTo we trust

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019	tolstak Спасибо огромное. Вижу в Вашем примере отрабатывает, переношу в свой — не работает и не понимаю почему. Может быть дело в _ в исключениях? Подскажите пжста чтоне так?

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

#16

22.07.2020 11:00:27

ageres1982, упс, кажется, малеленькая опечатка
Должно быть

Код

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replaceRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True

вместо

Код

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True

Прикрепленные файлы

Проверка.xlsm (67.55 КБ)

In GoTo we trust

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019	Спасибо Исключения теперь обходит, а когда нужно сделать замену выдаёт 13 ошибку. Добавил пример.

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

#18

22.07.2020 13:03:02

ageres1982, кажется, я совсем запутался в своем старом коде, прощу прощения…

Код

Option Explicit
Option Compare Text

Sub XXXX()
...
Dim replaceRn As Range, inputRn As Range, replacementsRn As Range, startingWordsToIgnoreRn As Range, rrow As Range, proceed As String, wordRn As Range, word As String, where_to_replace_cell As Range
    ' Определяем диапазон со значениями для замен
    With ThisWorkbook.Sheets("Замена")
        ' Фразы для замены
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
        ' Если ячейка начинается на эти слова - не делаем замену
        Set startingWordsToIgnoreRn = Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    
    With ThisWorkbook.Sheets("Поиск")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error GoTo 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
    For Each where_to_replace_cell In replaceRn.Cells
    ' По умолчанию - обрабытываем ячейку
        proceed = True
        ' Проверяем наличие слов из списка
        For Each wordRn In startingWordsToIgnoreRn
            word = wordRn.Value
            If Left(where_to_replace_cell.Cells(1, 1).Value, Len(word)) = word Then
                proceed = False
                Exit For
            End If
        Next wordRn
        ' Если нет слов из списка - начинаем замену.
        If proceed Then
            ' Для каждой пары заменяемых значений сделаем замену
            For Each rrow In replacementsRn.Rows
                where_to_replace_cell.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
            Next rrow
        End If
    
    Next where_to_replace_cell
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

Прикрепленные файлы

Проверка (2).xlsm (65.42 КБ)

Изменено: tolstak — 22.07.2020 13:38:15
(В очередной раз поправил формулу )

In GoTo we trust

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019	Не работает.. Z_BW_AUTH_AO_YPLANT_3305 — должно остаться без изменения т.к есть в списке исклюения (тут не ок), а для ZEAD_FI_03_02_D910 должен убраться хвостик _D910 (тут всё ок)

ageres1982 Пользователь Сообщений: 30 Регистрация: 15.10.2019	Спасибо огромное, теперь всё работает

Михаил Лебедев

Пользователь

Сообщений: 2856
Регистрация: 17.01.2013

#21

23.07.2020 10:11:14

Цитата
Nordheim написал: Еще вариант:

Красиво. Я бы только доделал, чтобы срабатывало и в том случае, если есть несколько слов на замену в одной ячейке. Хотя сейчас это ТС, похоже, не требуется

Всё сложное — не нужно. Всё нужное — просто /М. Т. Калашников/

Марина Александрова

Пользователь

Сообщений: 2
Регистрация: 18.08.2020

#22

08.10.2021 10:35:23

Подскажите пожалуйста, почему может не работать макрос. Суть в следующем: ячейки с «нет данных» (#Н/Д) заменить на пробел.

Код
Sub Макрос1()[ Cells.Replace What:="#Н/Д", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End Sub

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

#23

08.10.2021 10:56:43

Марина Александрова, возможно у Вас там формула выдает ошибку, а не значение #Н/Д.
В теории, можно написать такой макрос:

Код

    Dim errRn As Range
    ' Selection = Текущие выделенные ячейки
    For Each ccell In Selection
        If IsError(ccell) Then
            If errRn Is Nothing Then
                Set errRn = ccell
            Else
                Set errRn = Union(errRn, ccell)
            End If
        End If
    Next ccell
    If Not errRn Is Nothing Then
        'Значение для замены
        errRn.Value = " "
    End If
End Sub

Прикрепленные файлы

ErrClear.xlsm (17.19 КБ)

In GoTo we trust

Михаил Накаряков

Пользователь

Сообщений: 4
Регистрация: 02.04.2021

#25

18.11.2021 09:15:10

Цитата
написал: tolstak

Огромное спасибо, очень сильно помогли упростить рутину
Один момент только когда пытаюсь применить его в своем файле выдает ошибку на
Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
подскажите что с этим делать

Изменено: Михаил Накаряков — 18.11.2021 15:20:29

Источник

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

Создайте код макроса для поиска и замены текста в Excel

Создайте код макроса для поиска и замены текста в Excel

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

1. нажмите другой + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. в Microsoft Visual Basic для приложений окна, нажмите Вставить > Модули. Затем скопируйте ниже код VBA в окно кода.

Код VBA: создание кода макроса для поиска и замены текста в Excel

Sub FindandReplaceText()
'Update by Extendoffice 2018/5/24
    Dim xFind As String
    Dim xRep As String
    Dim xRg As Range
    On Error Resume Next
    Set xRg =Cells
    xFind = Application.InputBox("word to search:", "Kutools for Excel", , , , , 2)
    xRep = Application.InputBox("word to replace:", "Kutools for Excel", , , , , 2)
    If xFind = "False" Or xRep = "False" Then Exit Sub
    xRg.Replace xFind, xRep, xlPart, xlByRows, False, False, False, False
End Sub

3. нажмите F5 ключ для запуска кода.

4. В первом Kutools for Excel диалоговом окне введите текст или значение, которое вы будете искать, а затем щелкните OK кнопка. Смотрите скриншот:

5. В секунду Kutools for Excel диалоговом окне введите текст или значение, которое вы замените, и щелкните значок OK кнопку.

Затем все указанные тексты немедленно заменяются желаемым текстом.

Внимание: Этот код применяется к активному листу.

Статьи по теме:

Как найти и заменить все пустые ячейки на определенное число или текст в Excel?
Как заменить запятые на новые строки (Alt + Enter) в ячейках в Excel?
Как найти и заменить названия вкладок листов в Excel?
Как найти значение в ячейке со списком, разделенным запятыми в Excel?
Как найти пересечение двух списков столбцов в Excel?

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Комментарии (0)

Оценок пока нет. Оцените первым!

Источник

Excel VBA Найти и заменить

Excel VBA Найти и заменить

Вы когда-нибудь задумывались об автоматизации функции поиска и замены в Excel. В VBA мы можем создать макрос, который можно использовать для поиска и замены всего, что мы обычно делаем в Excel, путем нажатия сочетаний клавиш Ctrl + H. С помощью VBA Find and Replace мы можем автоматизировать поиск любого слова и заменить его другим замещением. Это помогает, когда нам нужно выполнить одно и то же действие несколько раз.

Как найти и заменить слова в Excel VBA?

Ниже приведены различные примеры, чтобы найти и заменить слова в Excel, используя код VBA.

Вы можете скачать этот шаблон VBA для поиска и замены Excel здесь — VBA для поиска и замены шаблона Excel

VBA Find and Replace — пример № 1

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

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

Шаг 1: Перейдите в меню « Вставка» в VBA и выберите « Модуль», как показано ниже.

Шаг 2: Как только мы это сделаем, мы откроем новый модуль. В этом модуле напишите подкатегорию от имени VBA Find and Replace, или вы можете выбрать любое имя этой подкатегории.

Код:

 Sub Find_Replace1 () End Sub

Шаг 3: Поскольку у нас есть данные в столбце B от ячейки B2 до B10, мы сначала выберем этот диапазон из B2: B10.

Код:

 Sub Find_Replace1 () Range ("B2: B10"). Replace End Sub

Шаг 4: Теперь, чтобы заменить что-то, нам нужно искать это слово. Здесь также мы сначала выберем функцию Replace, чтобы посмотреть, что нам нужно заменить.

Код:

 Sub Find_Replace1 () Range ("B2: B10"). Replace End Sub

Согласно синтаксису функции Replace, мы найдем то, что нам нужно заменить.

Шаг 5: Давайте выберем имя из списка « Бен » как то, что нам нужно заменить.

Код:

 Sub Find_Replace1 () Range ("B2: B10"). Replace What: = "Ben" End Sub

Шаг 6: Теперь выберите слово для замены, которым мы должны заменить выбранное слово. Здесь мы решили заменить имя Бен на Сэма, который упоминается как Замена, как показано ниже.

Код:

 Sub Find_Replace1 () Range ("B2: B10"). Replace What: = "Ben", Replacement: = "Sam" End Sub

Шаг 7: Теперь скомпилируйте код и запустите его, нажав на кнопку Play или нажав клавишу F5, как показано ниже.

Мы увидим, что все ячейки, содержащие имя Бена, теперь заменены именем Сэм . И это также выделено желтым цветом.

VBA Find and Replace — пример № 2

Мы все, возможно, столкнулись с ситуацией, когда мы пытались найти и заменить некоторые слова буквами с учетом регистра. Предположим, в списке, если мы хотим заменить только то слово, которое имеет несколько строчных или прописных букв. И если мы используем процесс, который мы видели в примере 1, то мы в конечном итоге заменим все подобные слова в этом списке вместе с требуемым. Этот процесс не может быть выполнен с помощью функции поиска и замены (Ctrl + H) в Excel. Для этого у нас есть положение в VBA.

Давайте рассмотрим ниже данные для этого. Как мы видим, мы специально добавили слово BEN в верхнем регистре в ячейку B2.

Выполните следующие шаги, чтобы найти и заменить слово BEN.

Шаг 1: Запустите подкатегорию VBA Find and Replace там, как показано ниже.

Код:

 Sub Find_Replace2 () End Sub

Шаг 2: Выберите список как Диапазон от B2 до B10.

Код:

 Sub Find_Replace2 () Range ("B2: B10") End Sub

Шаг 3: Теперь выберите точное слово, которое мы хотим заменить. Здесь мы выбрали BEN, который находится в ячейке B2.

Код:

 Sub Find_Replace2 () Range ("B2: B10"). Replace What: = "BEN" End Sub

Шаг 4: Опять же, мы выбрали то же слово, которое мы видели в примере 1, в качестве замены BEN, чем Сэм .

Код:

 Sub Find_Replace2 () Range ("B2: B10"). Replace What: = "BEN", Replacement: = "Sam" End Sub

Шаг 5: Теперь для замены точного слова BEN нам нужно использовать MatchCase, если оно становится TRUE, как показано ниже.

Код:

 Sub Find_Replace2 () Range ("B2: B10"). Replace What: = "BEN", Replacement: = "Sam", MatchCase: = True End Sub

MatchCase поможет нам определить то слово, которое мы хотим заменить точным соответствием. Здесь слово, которое мы выбрали, это BEN в верхнем регистре, а в списке есть и другие подобные слова, но в правильном.

Шаг 6: Теперь запустите код, нажав на кнопку Play или нажав клавишу F5.

Мы увидим, что слово BEN, которое было в ячейке B2, теперь заменено словом « Sam », выделенным желтым цветом. И подобные слова Бен, которые расположены в ячейках B5 и B8 соответственно, все еще остаются неизменными.

Вот как работает точное совпадение.

Шаг 7: Теперь мы удалим добавленный MatchCase из приведенного выше кода и посмотрим, как это будет работать.

Код:

 Sub Find_Replace2 () Range ("B2: B10"). Replace What: = "BEN", Replacement: = "Sam", MatchCase: = True End Sub

Шаг 8: Снова скомпилируйте и запустите код.

Мы увидим, что код заменил все ячейки, содержащие слово Ben, как показано выше. Это означает, что после удаления MatchCase код будет работать, как мы видели в примере 1.

Плюсы Excel VBA Найти и заменить

Основное обучение заключается в том, что мы можем заменить регистрозависимые слова и содержимое ячеек с помощью VBA Find and Replace, как показано в примере-2.
Если действие повторяется вручную и несколько раз, то автоматизация будет преимуществом в экономии времени и усилий.
Даже если у нас есть огромный набор данных, в котором мы хотим заменить определенные слова, это можно сделать, не нарушая Excel в громоздких файлах.

То, что нужно запомнить

Мы можем создать макрос функции Find and Replace с помощью опции Record Macro на вкладке Developer. Это самый простой способ создать макрос, если вы новичок в кодировании.
Сохранение файла в формате Macro Enable Excel позволит в будущем использовать код.
Мы можем заменить любой вид текста, слова, числа или символа VBA Find and Replace.

Синтаксис и параметры метода

Синтаксис

Параметры

Работа метода в VBA Excel

Пример 1

Пример 2

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

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

Создайте код макроса для поиска и замены текста в Excel

Статьи по теме:

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

Excel VBA Найти и заменить

Как найти и заменить слова в Excel VBA?

VBA Find and Replace — пример № 1

VBA Find and Replace — пример № 2

Плюсы Excel VBA Найти и заменить

То, что нужно запомнить

Рекомендуемые статьи

Найти И Заменить Сразу Несколько Значений Кодом VBA