Excelの範囲内の複数の値に対して2列の値で検索と置換を実行したい:Aは元のWordで、翻訳付きのB。これを50%動作させるVBAコードを既に見つけましたが、このコードはworskheet全体で実行します。
理想的には、選択した範囲のみで実行できるようにしたいと考えています。追加のボーナスは、ルックアップ範囲も選択できる場合です。
これは私がこれまで使ってきたものです。ご協力いただきありがとうございます!
Sub abbrev()
Dim abvtab() As Variant
Dim ltsheet As Worksheet
Dim datasheet As Worksheet
Dim lt As Range
'Change Lookup to the sheet name with your lookup table.
Set ltsheet = Sheets("Lookup")
'Change Data to the sheet name with your data.
Set datasheet = Sheets("Data")
'Change A2 to the top left cell (not the header) in your lookup table.
'Change B2 to top right cell.
Set lt = ltsheet.Range("A1", ltsheet.Range("B1").End(xlDown))
abvtab = lt
For i = 1 To UBound(abvtab)
datasheet.Cells.Replace What:=abvtab(i, 1), Replacement:=abvtab(i, 2), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End Sub
マクロは、検索範囲がどこにあるかを尋ねます。最初にシート名、次にルックアップ範囲アドレス。最初の列のみを入力してください。例:A1:A2
以下の例をご覧ください。
それでおしまい。これで、マクロはすべての置換ルールを反復し始め、それらを
通常のExcel検索と置換(Ctrl+H)選択した入力範囲に。
Input range Replace rules Input range after macro
Sub MultiReplace()
On Error GoTo errorcatch
Dim arrRules() As Variant
strSheet = InputBox("Enter sheet name where your replace rules are", _
"Sheet name", "Sheet1")
strRules = InputBox("Enter address of replaces rules." & vbNewLine & _
"But only the first column!", "Address", "A1:A100")
Set rngCol1 = Sheets(strSheet).Range(strRules)
Set rngCol2 = rngCol1.Offset(0, 1)
arrRules = Application.Union(rngCol1, rngCol2)
For i = 1 To UBound(arrRules)
Selection.Replace What:=arrRules(i, 1), Replacement:=arrRules(i, 2), _
LookAt:=xlWhole, MatchCase:=True
Next i
errorcatch:
End Sub