セルに入力した文字を別のシートで置換する方法

質問

複数置換を行いたいと思い、以下のマクロを作成しました。

If Range("B18") <> "" Then
Cells.Replace what:=Range("B18"), replacement:=Range("D18")
end if

B18のセルが空欄ではない場合、
そのセルに入った文字を検索し、別の文字に変換するというものです。

１つや２つほどであれば、ショートカットキーを使って
置換をしていけば良いと思うのですが、
10項目以上、置換しなくてはならず同時処理を行いたいと思っています。

ただし、その10項目については対象ファイルごとにバラバラで、
統一性がないため、VBAの中に組み込むよりかは、
置換したい文字を各セルに入れていき、置換できればと思い、
マクロの作成を行いました。

ただ、上のマクロでは同じファイルではないと処理ができません。
ActiveSheetを使って処理を行うとは思うのですが、どのように記述してよいか分かりません。
お力添えを頂ければと思います。

上記内容で分かり辛いかもしれませんので、以下に箇条書きします。

１）複数置換を行いたい。

２）Aセルに置換対象の文字を入れ、Bセルに置換したい文字を入れる。

３）実行すると全シート上でA１セルに入力された文字を検索し、B１セルに入力してある文字に置き換わる。

４）これらの処理は同一ファイルで行うのではなく、それぞれ別ファイルで管理をする。
※対象ファイルと実行データが別々のもの

以上です。
説明が分かりにくく、申し訳ありません。
もしVBAで以上のような処理が可能な場合、ご教授頂けますと幸いです。

（使用しているバージョンは、2003です。）

回答No.1

keithin · ベストアンサー

アナタの説明はすべて正確だとして、あなたが書きそびれたことをてきとーに補って、次のように設計します。
１）マクロを登録したブックのシート１のＡ列に検索する文字、Ｂ列に置換後の文字をそれぞれ列記する
２）マクロを実行した時点のアクティブブックの「全シート」に対して置換を行う
３）置換は部分一致で行う

sub macro1()
　dim r as long
　dim w as worksheet
　on error resume next
　for each w in activeworkbook.worksheets
　　with thisworkbook.worksheets("Sheet1")
　　for r = 1 to .range("A65536").end(xlup).row
　　　if .cells(r, "A") <> "" then
　　　　w.cells.replace what:=.cells(r, "A"), replacement:=.cells(r, "B"), lookat:=xlpart
　　　end if
　　next r
　　end with
　next
end sub

お礼

分かり辛い説明だったにも関わらず、
読み解いてくださり、また希望通りの処理をご提示いただき、
本当にありがとうございます！！

ActiveWorkbookを使用して処理を行うなど、
勉強になりました。

また、かなり早いレスポンスでお答え頂きましたので、
ベストアンサーとさせて頂きます。

本当にありがとうございました。

回答No.2

K Kazz（@JazzCorp）

'ブック内のシートを検索＆置換リストに従って検索＆置換
'Sheet1（シート名固定：変更可）に検索（Ａ列）＆置換（Ｂ列）リスト
'指定された内容の合理性は一切関知しない
'上から順序よく処理される
'検索語が空の場合、そのエントリは無効
'検索（LookAt）のオプション：全文一致「xlWhole」、部分一致「xlPart」

Sub MatchReplace()
Const xSheet = "Sheet1"
Dim sh As Worksheet
Dim xList As Long
Dim xRow As Long

For Each sh In Worksheets
If sh.Name = xSheet Then
xList = sh.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
End If
Next
For Each sh In Worksheets
If sh.Name <> xSheet Then
With ThisWorkbook.Worksheets(xSheet)
For xRow = 1 To xList
If .Cells(xRow, "A") <> "" Then
sh.Cells.Replace what:=.Cells(xRow, "A"), replacement:=.Cells(xRow, "B"), lookat:=xlPart
End If
Next xRow
End With
End If
Next
End Sub

お礼

「全文一致」と「部分一致」に関して、
丁寧に説明していただき、ありがとうございます。

実際に処理を行ってみたのですが、
sh.Cells.Replace what:=.Cells(xRow, "A"), replacement:=.Cells(xRow, "B"),
の部分に入らずに処理が終わってしまうようです・・・。

私の力不足で上手く動かすごとができず、
本当に申し訳ないです。

今回ご提示いただいたVBAをじっくりと研究し、
別の処理に生かしたいと思います。

この度は、ありがとうございました！