Макросы в 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 – поиск полного вхождения искомого текста в содержимое ячейки.

 

argyman

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

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

Добрый день!

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

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

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

Спасибо!

 

tolstak

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

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

#2

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 КБ)

Изменено: tolstak24.08.2018 14:24:14

In GoTo we trust

 

Nordheim

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

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

#3

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

#5

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

#8

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 K12.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 КБ)

Изменено: tolstak22.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

Есть две таблицы, одна оригинал, вторая для изменений. Все ученики кто получил 4 и выше имеют результат «Прошёл», у кого 3 и ниже — «Не прошёл».

Если будем использовать условное форматирование, придётся писать формулу каждый раз и если таблица очень большая и сразу хочется увидеть результат — лучше воспользоваться макросом. 

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

Как обычно:

  • вкладка «Разработчик», блок кнопок «Код»;
  • жмём «Visual Basic»;
  • добавляем новый модуль  Insert -> Module.

Вставляем следующий код.

Sub Result()
Dim cell As Range
‘ Проверка каждой ячейки диапазона на прохождение
For Each cell In Range(«I2:L10»).Cells
If cell.Value <= 3 Then
cell.Value = «Не прошёл»
ElseIf cell.Value >= 4 Then
cell.Value = «Прошёл»
End If
Next
End Sub

Быстрая замена значений по условию в Excel

В этом случае используется связка из команд IF и ElseIf, что позволяет нам несколько расширить понимание формулы ЕСЛИ. Напомню, что макрос будет применён только к ячейкам из диапазона I2:L10!

Запускаем выбор макросов с помощью сочетания клавиш Alt+F8 и нажимаем кнопку «Выполнить».

Быстрая замена значений по условию в Excel

Получаем результат. Во второй таблице я сразу вижу кто из учеников прошёл дальше, а кто нет. Ну и кому что необходимо подтянуть:)

Быстрая замена значений по условию в Excel

Таким образом решается некая ограниченность формулы ЕСЛИ, ведь условия в макросе можно продолжить и подобрать свои, всего лишь изменив значения.

Хитрости »

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


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

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

В ст В так сказать основной признак для сортировки данных за месяц в других столбцах
Предполагается что он будет таким на протяжении всего месяца
Но вдруг какое-то событие — и на определенной неделе признак меняется и становится как в ст D

Прошел месяц

Начался новый

Старый файл сохраняется в архив как есть

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

И тут надо вернуть значения ст D в соответствие со ст В Т.е. снова предположить что признак от недели к неделе не будет меняться

Добавлено через 1 минуту
Столбцы сопоставлять по строкам
B1 — D1

Добавлено через 4 минуты
Причем предполагается что периодов в месяце 5
Основное значение задается перед первым периодом и в каждом периоде может меняться
Т е приводить в соответствие нужно 4 стобца

Добавлено через 8 минут
Т.е. хотелось бы выбирать столбцы в которых производить замену
Да еще и для каждого листа книги разные столбцы могут быть
(по высоте в том числе)

Добавлено через 12 минут
И еще!!! Изначально во всех «неглавных» столбцах первоначально стоит формула простой прямой ссылки на главный
И с идеале эту же формулу ссылки вернуть нужно после выполнения макроса

Найти и заменить в открытых книгах или нескольких листах:

Kutools for ExcelАвтора Найти и заменить функция может помочь вам найти и заменить значения из открытых книг или конкретных рабочих листов, которые вам нужны.

док-множественный найти и заменить-6

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


Если вы устали от поиска и замены значений снова и снова, следующий код VBA может помочь вам сразу заменить несколько значений вашими необходимыми текстами.

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

3. Щелчок Вставить > модуль, и вставьте следующий код в окно модуля.

Код VBA: поиск и замена сразу нескольких значений

1

2

3

4

5

6

7

8

9

10

11

12

13

14

Sub MultiFindNReplace()

Dim Rng As Range

Dim InputRng As Range, ReplaceRng As Range

xTitleId = "KutoolsforExcel"

Set InputRng = Application.Selection

Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)

Application.ScreenUpdating = False

For Each Rng In ReplaceRng.Columns(1).Cells

    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value

Next

Application.ScreenUpdating = True

End Sub

4, Затем нажмите F5 для запуска этого кода, в раскрывающемся окне подсказки укажите диапазон данных, который вы хотите заменить значениями новыми значениями.

5. Щелчок OK, и появится другое окно подсказки, чтобы напомнить вам, выберите критерии, которые вы создали на шаге 1. Смотрите скриншот:

6, Затем нажмите OK, все конкретные значения были заменены новыми значениями по мере необходимости.

doc multiple find заменить 5


Статья: https://www.extendoffice.com/ru/documents/excel/1873-excel-find-and-replace-multiple-values-at-once.html

excelWhile  working with MS Excel , sometimes you may need to delete values in strings or change them. You can automate that by using the powerful Replace() which is available in Excel VBA (Visual Basic for Applications). Today, we walk you through the series of steps to understand and master the Replace() function. The prerequisites for this intermediate course are the basic knowledge of Excel (here’s a course that can give you an introduction to Excel 2o13), strings and preliminary understanding of Excel VBA. If not, we recommend that you go through this beginner’s course on Excel VBA and macros. For a quick refresher, you can do a quick read through of our VBA tutorial.

 Excel VBA Replace() is a simple yet very useful string function. As the name suggests, Replace() is used to replace a set of characters in a string with a new set of characters. The basic syntax of a VBA Replace function looks like this:

Replace(Source_string, Old_string, Replacement_string, [start, [count, [compare]]] )

Let’s go through each parameter to understand them better.

  • Source_string: This is the complete source string, of which you want some characters to be replaced.
  • Old_string: It’s the string which is to be replaced, ie the subset of source_string that you want to replace
  • Replacement_string: Is the string or a set of characters with which you want “Old_string” is to be replaced.
  • Start: Stands for the numerical position in the “Source_string” from which the search should start. This is an optional parameter. If this parameter is omitted, then by default the search begins at position 1.
  • Count: This parameter stands for the frequency of occurrences of Old_string to be replaced. Like “start”, it’s an optional parameter. If this argument is omitted, then each occurrence of “Old_string” in the “Source_string” will be replaced.
  • Compare: This is also an optional parameter. It represents the type of comparison algorithm to be used while the Replace Function searches for the occurrences of “Old_string” in the “Source_string.” Here are your options:
    1. vbBinaryCompare is the parameter value for binary comparison.
    2. vbTextCompare is the argument for textual comparison.
    3. Finally, the parameter value vbDatabaseCompare does a comparison based on information in your database.

Now that we’re familiar with the syntax of Replace function, lets move on to a few simple practical examples.

Examples

Replace (“Thank You", "You", "Everybody")

This example will return, “Thank Everybody”.

Replace ("Software Program", "Unique","code")

Guess what this will return? The code will return “Software Program.” The reason is we have asked the Replace function to replace “Unique.” However, you can see that “Unique” text string is not present inside the source string. So, Replace will leave the source string unchanged.

Replace ("Animal", "a", "f",2)

This code will return, “Animfl.” The reason is in the Replace function code, the search for character “a” starts from the second position. Wherever, “a” is found, it is replaced with “f”.

Replace ("Animal", "a", "f",1,1)

Here the Replace() will return “fnimal”.  The reason being we have instructed the VBA Replace statement to replace only one occurrence of “a” with “f”.

We suggest you work out these examples and learn a bit more about VBA macros (you can use this VBA course) before moving on to more complex programs using Replace function. Here on, we will use the Visual Basic Editor to write the code. We assume that you know how to save, compile and run programs on this editor. You can always look up our course on Excel VBA and Macros here.

How  to Remove Space from a String

Sub removeSpace()
Dim stringSpace As String
stringSpace = " this string contains spaces "
stringSpace = Replace(stringSpace, " ", "")
End Sub

Here we have declared stringSpace to be a variable of type string. It is initialized to a string which contains spaces. Replace() has the ‘stringSpace’ to the be source string. Every occurrence of space in the source string is removed using VBA Replace statement. Finally, stringSpace contains “thisstringcontainsspaces” which is the end result.

How to Replace a String within Inverted Comma

Sub replaceQuotedString()
Dim y, longString, resultString1 As String
y = Chr(34) & "abc" & Chr(34)
longString = "Let's replace this string: " &y
resultString1 = Replace(longString, y, "abc")
End Sub

Here we declare y, longString, resultString1 as variables of data type string. Chr() converts the numerical values to string data type. In other words, it introduces the quotation marks to the numerical values. And(&) operator concatenates strings. Value of “y” is “34abc34.” The  “longString” value is “Let’s replace this string: 34abc34″. In the Replace() value of source string is  the “longString.” That is “34abc34” is replaced by “abc”.  The resultstring1 now stores the value “Let’s replace this string: abc”

How to Remove Square Brackets from a String using Excel VBA

Sub removeSquareBrackets1()
Dim trialStr As String
trialStr = "[brackets have to be removed]"
trialStr = Replace(trialStr, "[", "")
trialStr = Replace(trialStr, "]", "")
MsgBox (trialStr)
End Sub

In this program, we’ve declared trialStr as a variable of type string.  It’s assigned the value”[brackets have to be removed].” The first occurrence of the replace function removes the left square bracket from trialStr. The variable now contains “brackets have to be removed].” In the second occurrence of the Replace function, the right square bracket is removed. Finally the value of trialStr is “brackets have to be removed.” Note that there are no square brackets in trialStr now. And the MsgBox() displays  the result.

How to Edit a Url Using Replace()

Enter this formula into any cell in your current Excel sheet.

=HYPERLINK("http://www.microsoft.com", "Microsoft Headquarters")

This creates a hyperlinked URL in the active cell of your worksheet. In the VBA editor, write the following code

Sub editURL1()
Dim URL1, NewURL
URL1 = ActiveCell.Formula
NewURL = Replace(URL1, "Microsoft Headquarters", "World Office")
ActiveCell.Formula = NewURL
End Sub

In this program, we’ve declared URL1 and NewURL as variables. URL1 is initialized to the value in the selected cell. Replace () searches for occurrence of “Microsoft Headquarters” in the URL and replaces it with “World Office.”  The selected cell is assigned the value of NewURL.

Programming using Excel VBA is interesting and gives you exposure to powerful functionality and features. Mastering it is important to efficiently and effectively use Excel.  Once you’ve tried these examples for yourself, do share your learning and experience with us. Once you’re ready to take the next step, hop over to this Ultimate VBA course, to check out some advanced VBA concepts.

Понравилась статья? Поделить с друзьями:
  • Макросы в excel курсы онлайн
  • Макросы в excel замена в формулах
  • Макросы в excel копировать строку
  • Макросы в excel закрыть книгу с сохранением
  • Макросы в excel копирование ячейки в другую