複数ファイルの内容の文字列置換

エクセルで請求書を作成しています。
会社の電話番号が変わったので、
電話番号の一括変改をしたいと考えています。
複数ファイルの内容を一括変換する方法はありますでしょうか？

No.3 回答者： ja7awu 回答日時： 2005/04/09 14:15

コードの訂正です。

最後から13行目を次のように訂正してください。
このコードを設定したブックが、検索用ホルダにある場合、自身の検索を除外します。

　　If Mypath & FName = ThisWorkbook.FullName Then FName = Dir

No.2 回答者： ja7awu 回答日時： 2005/04/09 11:45

> 複数ファイルの内容を一括変換する方法はありますでしょうか？

VBAを使用することにより、一括置換えることが、出来ます。

該当するブックのホルダが、どのように分布しているのかが分りませんので、

ここでは、1つのホルダを指定して、その中の全てのブック(.xls)を検索し、
見つかったら、全て置換えるように、作ってみました。

宜しかったら、新規ブックでテストしてみてください。

一応、ご存知とは思いますが、操作手順を詳しく書いて置きます。

１．Alt + F11 で VBE(Visual Basic Editor)を開きます。
２．VBE のメニューから[挿入] -->[標準モジュール] を指定します。
３．モジュールウィンドウに下記コードをコピーして貼り付けます。
４. コードの 2～4 行目の "　" の中を実情に合わせて変更します。
５．Alt + Q （または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
６．メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
　「中」にして[OK]します。
７．実行するときは、Alt ＋ F8 (メニューから[ツール]-->[マクロ]-->[マクロ])で
　「フォルダ内ブック文字列置換え」を指定し、[実行]ボタンを押します。

これで、全部置換えになると思います。

・ 検索対象ブックのシート内で、他ブックのセル参照が設定されている場合は、
　 その旨のダイアログボックスが表示されます。

・ 検索を終了すると、検索対象ブック数と、置換え総件数が表示されます。


Sub フォルダ内ブック文字列置換え()
Const Mypath = "C:\DATA\" '　　　　　　<--- 検索フォルダ名を指定
Const OldStr = "0123-45-6789" '　　　　<--- 置換え旧文字列
Const NewStr = "0123-98-7654" '　　　　<--- 置換え新文字列
Dim WB As Workbook
Dim Rng As Range
Dim FName As String
Dim Bcnt As Integer
Dim Dcnt As Integer
Dim Scnt As Integer
Dim N As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
FName = Dir(Mypath & "*.xls", vbNormal)
Do While FName <> ""
　　Set WB = Workbooks.Open(Mypath & FName)
　　Bcnt = Bcnt + 1
　　Scnt = 0
　　Windows(WB.Name).Visible = False
　　For N = 1 To WB.Worksheets.Count
　　　　Set Rng = WB.Worksheets(N).Cells.Find(OldStr)
　　　　If Not Rng Is Nothing Then
　　　　　　Scnt = Scnt + 1
　　　　　　Do
　　　　　　　　Rng.Value = Replace(Rng.Value, OldStr, NewStr)
　　　　　　　　Dcnt = Dcnt + 1
　　　　　　　　Set Rng = WB.Worksheets(N).Cells.FindNext(Rng)
　　　　　　Loop Until Rng Is Nothing
　　　　End If
　　Next N
　　If Scnt = 0 Then
　　　　WB.Close SaveChanges:=False
　　Else
　　　　Windows(WB.Name).Visible = True
　　　　WB.Close SaveChanges:=True
　　End If
　　FName = Dir
　　If FName = ThisWorkbook.FullName Then FName = Dir
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
If Bcnt = 0 Then
　　MsgBox "指定したフォルダに、ブックは見つかりませんでした。", , "検索完了"
Else
　　MsgBox Bcnt & " のブックを検索し " & Dcnt & " 箇所を書換えました。", , "置換え完了"
End If
Set WB = Nothing
Set Rng = Nothing
End Sub

No.1 回答者： neKo_deux 回答日時： 2005/04/08 20:18

OfficeGrep

http://www.vector.co.jp/soft/win95/util/se190183 …

などのソフトを利用するのがお手軽です。


あるいは、マクロ、VBAを利用すれば処理可能ですので、こちらに挑戦してみる方が良いかも。