☰

Найти и заменить несколько слов в столбце в Excel 2007

tag-icon • tag-icon microsoft-excel-2007 vba macros
Найти и заменить несколько слов в столбце в Excel 2007 
Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:=too(i)
Next i
End Sub

Я использую приведенный выше код для поиска и замены нескольких слов (в «Столбце A Листа 1» словами в «Столбце B Листа 2») в указанном ниже листе:

https://docs.google.com/spreadsheets/d/15TRLccDr_EAR8s78u-WGSkGpAecBf42_lhRkjCev_WE/edit?usp=sharing

Однако когда я применяю это на другом листе (как указано ниже) для других данных, то код дает сбой, т.е. я получаю искаженные слова на листе 1:

https://docs.google.com/spreadsheets/d/14ba9pQDjMPWJd4YFpGffhtVcHxml0LdUUVQ0prrOEUY/edit?usp=sharing

Пожалуйста, помогите мне заменить слова в «Столбце A Лист1» на слова в «Столбце B Лист2»

Примечание: Выше были даны ссылки на таблицы Google, однако у меня возникли проблемы с таблицами Excel 2007.

Я прошу вас помочь мне, предоставив весь исправленный код, так как я не силен в VBA.

решение1

Я предполагаю, что вы хотите сделать замену только один раз и остановить дальнейшие правила, как только замена будет сделана. Возьмем в качестве примера ваш второй лист, строку 12 "but" следует перевести в "however", и остановить дальнейшие правила, чтобы "however" не переводилось в "hoyouever" (поскольку правило № 17 переводит "we" в "you").

Обходной путь — сначала перевести все в какой-то промежуточный символ, а во втором раунде перевести из промежуточных символов в желаемую замену. Небольшое изменение вашего кода, как показано ниже, будет работать:

Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

' -------------- Modification starts here --------------------------
' Replace from from(i) to __MYREPLACEMENTi__  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:="__MYREPLACEMENT" + Str(i) + "__"
Next i
' Replace from __MYREPLACEMENTi__ to too(i)  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:="__MYREPLACEMENT" + Str(i) + "__", Replacement:=too(i)
Next i
' -------------- Modification ends here --------------------------
End Sub

Связанный контент