こんにちは！ 健史です。
Ｅｘｃｅｌファイルで保管されている文書の文字列を一括で修正したいということありませんか。
プログラムで指定したフォルダ内のＥｘｃｅｌファイルの文字列を修正する処理を作成してみました。
尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。
Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。
実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)
プログラムの概要
今回のサンプルプログラムは
イメージは以下です。
1.入力
◇設定
◇対象フォルダとファイル
2.出力
仕様概要は、以下の通りです。
1.設定シートの内容をチェックする
・値に間違いがないか
・対象ファルダが存在するかなど
2.対象フォルダのExcelを順次読み込み、指定文字列を検索・置換する
・検索の場合は上書き保存しない
・置換の場合には上書き保存する
Excelで作成したドキュメントですが、組織変更やニーズの変更などでドキュメントの中から、
・影響範囲を探して影響度合いを計る
・一括で特定の文字を変更したい
と言った場合を想定して作ってみました。
数少ないファイルであれば手で対応できますが、数多い場合に１つひとつファイルを開いて検索して内容を別Excelに転記するのはたいへんです。
サクラエディタのGrep検索は、テキストなどのファイルには対応できますが、Excelファイルでは想定通りに動作しませんでした。
プログラムの作成と実行
1.データ準備
1).検索・置換対象となるデータ
フォルダを作成し、検索・置換対象のExcelファイルだけを格納しておきます。
もしくは実際に試してみたいファイルがあれば、新たに作成した、万が一間違ってもよい対象フォルダにコピーし試します。
まずはお試しであり、いきなり本物の実データで操作しないで下さいね、今回は置換機能があり上書きしてしまいますので。
使ってみて問題ないことを確認でき「問題なし」と判断しても、実務で使っているデータで一括置換する場合、必ず「置換前のデータをバックアップ」もしくは「新規に作成したフォルダにコピーしたファイルで実施」などリカバリできるようにしておくことは、これに限らず更新系作業では必要不可欠です。
正常に更新出来たことを確認できたら削除すればよいのですから。
2.Excelを起動
1).シート１(設定シート)に以下のデータを貼り付ける
ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])
"操作指定 1:検索 2:置換" "検索一致指定 1:部分 2:全体" 検索文字 "置換文字 置換の場合に有効" 対象フォルダ 1 1 sample1 G:\TEST ※注意 「置換」の場合はファイルを上書きします！ 出力の見出し フォルダ名 ファイル名 シート№ シート名 セル 置換前の内容 置換後の内容
崩れているように見えますが、１つのセルの中に改行があるためで、実際には想定通りに貼り付きます。
改行がある又は文字数が多いセルは貼り付けた後、セルの縦幅・横幅を広げると全体を表示できます。(広げないと隠れてしまっていて全体を見れません)
プログラムを実行する場合のフォルダ名や検索文字は、実際の環境に合わせて修正します。
3.Excel-VBAを起動
Altを押した状態でF8キーを押します。
4.[マクロ名(M):]に'test'と入力(''は不要、''内のtestを入力)
5.[作成(C)]をクリック
6.以下のプログラムをドラッグ＆コピー
'対象ファルダから読み込むファイルを指定。Excelのみにする場合は"\*.xlsx"や"\*.xls"
Const cnsDIR = "\*.*"
'出力シートの見出し項目数
Const mds_max As Long = 7
'エクセルシートを複数同時に使うので、変数として定義
Dim excel1 As Workbook
Dim excel2 As Workbook
'変数定義
Dim ix1, iy1, ix2, iy2, ix2_max, iy2_max, ix2_sav, iy2_sav As Long
Dim strOper, strFind, strChr1, strChr2, strPath As String
Dim strFilename As String
Dim cntSht As Long
'ワークシート、範囲を変数として定義
Dim ws As Worksheet
Dim rng_1, rng_tmp As Range
'変数:excl1に起動した(この)ファイルを設定
Set excel1 = ActiveWorkbook
'起動した(この)ファイルのシートからワーク領域へ取り込み
With excel1.Sheets(1)
strOper = .Cells(2, 1)
strFind = .Cells(2, 2)
strChr1 = .Cells(2, 3)
strChr2 = .Cells(2, 4)
strPath = .Cells(2, 5)
End With
'起動した(この)ファイルのシート２をクリアし見出しをセット
With excel1
.Sheets(2).Cells.Clear
For iy1 = 1 To mds_max
.Sheets(2).Cells(1, iy1) = .Sheets(1).Cells(7, iy1)
Next
End With
'ワーク領域へ取り込んだ項目のチェック
If strOper = 1 Or strOper = 2 Then
Else
MsgBox "操作指定が1,2でありません！"
GoTo L900
End If
If strFind = 1 Or strFind = 2 Then
Else
MsgBox "検索指定が1,2でありません！"
GoTo L900
End If
If strChr1 = "" Then
MsgBox "検索文字が指定されていません！"
GoTo L900
End If
If strOper = 2 And strChr2 = "" Then
MsgBox "置換なのに置換文字が指定されていません！"
GoTo L900
End If
If strOper = 1 And strChr2 <> "" Then
MsgBox "検索なのに置換文字が指定されています！"
GoTo L900
End If
If Dir(strPath, vbDirectory) = "" Then
MsgBox "対象フォルダがありません！"
GoTo L900
End If
'起動した(この)ファイルのシート２へセットするための添字に１を設定
ix1 = 1
'対象フォルダから最初のファイル名を取得
strFilename = Dir(strPath & cnsDIR, vbNormal)
'対象フォルダのファイル名を取得できなくなるまで繰り返す
Do While strFilename <> ""
'取得したファイルをオープンすると同時し、変数:excl2へ設定
Set excel2 = Workbooks.Open(strPath & "\" & strFilename)
'すべてのシート(Sheets.Count)を処理する
For cntSht = 1 To excel2.Sheets.Count
'変数:wsへワークシートをセット
Set ws = excel2.Sheets(cntSht)
'変数:wsのワークシートから最終行・列を取得する
ix2_max = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
iy2_max = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
'検索・置換する範囲を変数:rng_1へセットし最初に見つかる文字を検索する
Set rng_1 = ws.Range(ws.Cells(1, 1), ws.Cells(ix2_max, iy2_max))
If strFind = 1 Then
Set rng_tmp = rng_1.Find(strChr1, LookIn:=xlValues, lookat:=xlPart)
Else
Set rng_tmp = rng_1.Find(strChr1, LookIn:=xlValues, lookat:=xlWhole)
End If
'検索する文字がなければスキップしL100へジャンプ
If rng_tmp Is Nothing Then
GoTo L100
End If
'最初に見つかった文字の行・列を退避しておく
ix2_sav = rng_tmp.Row
iy2_sav = rng_tmp.Column
'起動した(この)ファイルのシート２へ項目をセットし、次の文字を検索する
Do
ix2 = rng_tmp.Row
iy2 = rng_tmp.Column
If (strFind = 1) Or _
(strFind = 2 And strChr1 = ws.Cells(ix2, iy2)) Then
ix1 = ix1 + 1
With excel1.Sheets(2)
.Cells(ix1, 1) = strPath
.Cells(ix1, 2) = strFilename
.Cells(ix1, 3) = cntSht
.Cells(ix1, 4) = ws.Name
.Cells(ix1, 5) = Replace(rng_tmp.Address, "$", "")
.Cells(ix1, 6) = ws.Cells(ix2, iy2)
If strOper = 2 Then
.Cells(ix1, 7) = Replace(ws.Cells(ix2, iy2), strChr1, strChr2)
End If
End With
End If
Set rng_tmp = rng_1.FindNext(rng_tmp)
'次に検索した文字が退避した行・列と同じになったら終了
Loop Until rng_tmp.Row = ix2_sav And rng_tmp.Column = iy2_sav
'検索の場合は次のシートの処理へ
If strOper = 1 Then
GoTo L100
End If
'文字の一括置換
If strFind = 1 Then
ws.Cells.Replace What:=strChr1, Replacement:=strChr2, lookat:=xlPart
Else
ws.Cells.Replace What:=strChr1, Replacement:=strChr2, lookat:=xlWhole
End If
L100: '検索する文字がなかった場合のジャンプ先
Next
'検索の場合はセーブしないで閉じて、置換の場合はセーブして閉じる
If strOper = 1 Then
Call excel2.Close(False)
Else
Call excel2.Close(True)
End If
'対象フォルダから次のファイル名を取得する
strFilename = Dir()
Loop
'最後にファイル名、シート№、セルでソート
With excel1.Sheets(2)
.UsedRange.Sort _
Key1:=.Range("B1"), Order1:=xlAscending, _
Key2:=.Range("C1"), Order2:=xlAscending, _
Key3:=.Range("E1"), Order3:=xlAscending, _
Header:=xlYes
End With
L900:
7.以下に貼り付け(ペースト)
Sub test()
ここに貼り付ける
End Sub
8.F5キーで実行
9.実行結果の確認
出力シートに検索した文字の内容が入っています。
設定シートの[操作設定]で「2:置換」を指定、置換文字に例えば"sample2"と入力して実行すれば置き換えます。
ただし[検索指定]により一致した文字を置換しますので、「1:部分」の場合は全てを置換し「2:全体」の場合は指定した文字だけのセルが対象になります。
プログラムの詳細説明
処理対象フォルダからファイ名を取得し読み込む処理は、以下の記事を参照下さい。
For文については、以下の記事を参照下さい。
範囲を指定して検索する処理は、以下の記事を参照下さい。
(このサイトを始めて訪れ当記事を目にされた方には恐縮ですが)これまで紹介してきたプログラムには無く新たに使ってみたものは
・２つのExcelファイルを同時に使う
・[With ～ End With]を使う
・[Sort]を使う
です。
最初に上記３つを補足してから、その他を補足します。
２つのExcelファイルを同時に使う
１つのExcelファイル内のシートを切り替えて参照する場合には、例えば
If Sheets(1).Cells(1, 1) = Sheets(2).Cells(1, 1) Then ～
と記述し、複数のファイルを開いて処理する場合の「どのファイル」を使うかということは意識しません。(これまで紹介したプログラムは意識しませんでした)
２つのExcelファイルである、①設定シート・出力シート・ＶＢＡのプログラムを記述してあるファイル、②①の設定シートの内容から読み込んだファイル を同時に、例えば
If ①のSheets(1).Cells(1, 1) = ②のSheets(2).Cells(1, 1) Then ～
というように処理する場合です。
やり方は参照したいファイルをプログラム内でオブジェクト、１つの物体というか物として定義して使用します。
これだけではわかりませんね、具体的に説明します。
２つ以上のファイルを同時に使いたい場合は、
1.使いたいファイルの数だけファイル用の変数を定義する。
Dim excel1 As Object
Dim excel2 As Object
2.ファイルを開くと同時に上記ファイル用の変数に「開いたExcel、この後使うExcelはこれですよ」というものをセットする。
1).プログラムから他のファイルを使う場合
Set excel1 = Workbooks.Open(strPath1)
Set excel2 = Workbooks.Open(strPath2)
とか
Set excel1 = Workbooks.Open("D:\EXCLFILE1.xls")
Set excel2 = Workbooks.Open("D:\EXCLFILE2.xls")
です。
他の方法もありますが、後者のファイルをオープンしたと同時にセットするのが良いと思います。
2.①設定シート・出力シート・ＶＢＡのプログラムを記述してある最初に起動するファイルの場合
Set excel1 = ThisWorkbook
です。
Set excel1 = ActiveWorkbook
でもよいですが、処理を開始し②のファイルも開いた直後のファイルの場合は②がセットされます。
その場合は、他のファイルを開く前に記述します。
詳しくは以下を参照下さい。
参考：ThisWorkBookとActiveWorkBookの違い
3.参照する
Sheets(x).Cells～の前にセットしたオブジェクト名を付けます。
IF excel1.Sheets(1).Cells(1,1) = 1 Then
excel2.Sheets(1).Cells(1,1) = excel1.Sheets(1).Cells(1,2)
End If
「excel1.Sheets(1).Cells(1,1)」のように。
[With ～ End With]を使う
以下の記述を例に説明します。
With excel1.Sheets(1)
strOper = .Cells(2, 1)
strFind = .Cells(2, 2)
strChr1 = .Cells(2, 3)
strChr2 = .Cells(2, 4)
strPath = .Cells(2, 5)
End With
上記記述は、
strOper = excel1.Sheets(1).Cells(2, 1)
strFind = excel1.Sheets(1).Cells(2, 2)
strChr1 = excel1.Sheets(1).Cells(2, 3)
strChr2 = excel1.Sheets(1).Cells(2, 4)
strPath = excel1.Sheets(1).Cells(2, 5)
と同じです。
同じコーディング[excel1.Sheets(1)]を各行で省略できます。
プログラムの記述量を少なくでき、コーディングミスのリスクを減らすことができ、量が少なければ見やすくなります。
１行であれば不要でしょうか、記述しても良いですかね、お好みで。
[Sort]を使う
出力シートの内容を[ファイル名][シート№][セル]をキーに昇順でソートしています。
Header:=xlYes
は、１行目がヘッダー部でソート対象外とする場合に指定します。
今回ソートする理由は以下です。
sample1.xlsでは、セル[A1]に検索対象「sample1です。」を入力しています。
この状態で実行すると、2番目の文字列から検索を開始します。
実際にソート部分をコメントにして実行すると、sample1.xlsのシートは、C3→E5→A1の順に出力されます。
出力シートに表示する順番は、上から下へにしたいです。
セル[A1]から検索するようにネットの記事をいくつか試したのですが、古いExcel2003のせいなのかできませんでした。
そのため仕方なく、シート№も付けてセルのアドレスで並び替えることにしました。
検索処理の補足
今回は2つの検索機能を使っています。
①最初に[Find]で検索文字を見つけます。
②最初に見つけた文字の次の文字を連続して見つける場合は[FindNext]を使います。
[FindNext]を「どこまで、いつまで続けるか」というと、
「①で見つけたときのセルの位置に戻るまで」です。
具体的には、
①で見つけたときのセルの位置を退避しておく
ix2_sav = rng_tmp.Row
iy2_sav = rng_tmp.Column
②の[FindNext]で検索した内容が①で退避した値と等しくなれば終了
Set rng_tmp = rng_1.FindNext(rng_tmp)
Loop Until rng_tmp.Row = ix2_sav And rng_tmp.Column = iy2_sav
[Until]条件を入れないと永遠に繰り返します。
置換処理の補足
置換の場合、出力シートに記録する置換後の内容は
If strOper = 2 Then
.Cells(ix1, 7) = Replace(ws.Cells(ix2, iy2), strChr1, strChr2)
End If
で置き換えた値ですが、実際の置換は
If strFind = 1 Then
ws.Cells.Replace What:=strChr1, Replacement:=strChr2, lookat:=xlPart
Else
ws.Cells.Replace What:=strChr1, Replacement:=strChr2, lookat:=xlWhole
End If
で一括で置き換えています。
出力シートに記録する置換後の文字列処理で置き換えた内容をセットしても同じですが、多くの命令を試みるため敢えて変えました。
出力シートの見出し設定の補足
出力シートの見出しですが、設定シートの７行目に入力した値を設定しています。
何らかのデータ作成する場合は、何度実行しても良いように、何度実行しても出力するデータは「まっさら状態にしたシートに出力する」考えで作成しています。
今回プログラム内でダブルクォテーションで囲った見出しの文字列をセットするようにしていたのですが、プログラムの行数が長くなってしまったこともあり、設定シートにおいた値をセットするように変更してみました。
最後に
「ＥＸＣＥＬファイルの文字列を一括で検索・置換するプログラム」でした。
テキストファイルの文字列を一括置換するプログラムは以下です。
Ｗｏｒｄファイルの文字列を一括置換するプログラムは以下です。
手間の掛かる面倒かつ単純作業は機械やコンピュータで処理して、”判断”や"評価"など機械やコンピュータができない作業は人間が行うようにしたい、エネルギーを注ぎたいものです。
そんな思いから他のプログラムも記事にしています。
参考にして頂ければと思います。
コメント