Sub MultiReplacement()
Dim MyWords As Variant
Dim MyRepWords As Variant
Dim Ans As Integer
Dim Rng As Range
MyWords = Array("澤", "高梁", "髙橋") 'ここに検索語を入れてください。
MyRepWords = Array("沢", "高橋", "高橋") 'ここに置換語を入れてください。
'検索語と置換語を調べる
If UBound(MyWords) UBound(MyRepWords) Then
MsgBox "検索語数( " & UBound(MyWords) & _
" )と置換語数( " & UBound(MyRepWords) & " )数が違います。", 64
Exit Sub
End If
Set Rng = Selection 'マウスで範囲を選択してください。
If Rng.Count = 1 Then
Ans = MsgBox("セル１つしか選択されていませんが、よろしいですか？", vbYesNo)
If Ans = vbNo Then
Exit Sub
End If
End If
'実行
For i = LBound(MyWords) To UBound(MyWords)
Cells.Replace What:=MyWords(i), Replacement:=MyRepWords(i), _
LookAt:=xlPart, _
MatchCase:=True
Next i
End Sub
メンバー 
