Excel 2007 で列内の複数の単語を検索して置換する

Question

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

ただし、これを別のシート (以下で説明するように) で別のデータに適用すると、コードは失敗し、sheet1 に歪んだ単語が表示されます。

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

「列 A シート 1」の単語を「列 B シート 2」の単語に置き換えることができるように手伝ってください。

注: 上記のリンクは Google スプレッドシートのものですが、Excel 2007 シートで問題が発生しています。

私はVBAが得意ではないので、修正されたコード全体を提供して助けていただきたいと思います。

Answer 1

必要なのは、置換を 1 回だけ行い、置換が行われた時点でそれ以上のルールを停止することだと思います。2 枚目のシートを例にとると、12 行目の「but」は「however」に翻訳し、それ以上のルールを停止して、「however」が「hoyouever」に翻訳されないようにします (ルール #17 が「we」を「you」に翻訳するため)。

回避策としては、まずすべてを何らかの中間シンボルに変換し、2 回目に中間シンボルから目的の置換に変換します。以下のようにコードを少し変更すると機能します。

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