Столкнулся с проблемой автоматизации массовых замен (Ctrl+H). Мини пример во вложении.
Столбец А - список названий, столбец С - список выражений, которые нужно заменить, столбец D - список, на что нужно заменять значения из столбца C.
Нужно автоматизировать процесс замен (все замены делать парой кликов). Чтобы все выражения из столбца D заменялись на соответствующие значения из столбца C. С условием, что каждая последующая замена выполняется на основе предыдущей (проще говоря, делаем первую замену из списка и обновляем список с названиями товаров, чтобы вторая замена была уже по исправленному списку и т.д. все замены).
Мб кто-то реализовывал уже? (довольно базовая задача, вроде как).
Для не слишком большого количества данных можно использовать последовательную замену функцией ПОДСТАВИТЬ(). Видимо, она не будет обрабатывать Вашу маску типа "? вида..." и "? видов...", но большую часть замен произвести можно.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Юрий М, ну вроде да - там как раз используется методReplace
Код
Код
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
единственное — я бы (как всегда говорю) целиком прописал параметры метода во избежание косяков
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄