EXCEL VBA

Excel-VBA 実例 Excelの文字列を一括検索・置換

EXCEL VBA

こんにちは! 健史(たけふみ)です。

Excelファイルで保管されている文書の文字列を一括で修正したいということありませんか。

プログラムで指定したフォルダ内のExcelファイルの文字列を修正する処理を作成してみました。

尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。

Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。

Excel-VBA 実例 この通りやれば動く、とにかく触ってみよう
こんにちは! 健史(たけふみ)です。 パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。 この記事は、Exceは知っているけれど ・Excel-VBAって何? ・Excel-VBAは取っ付きにく...

実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)

スポンサーリンク

プログラムの概要

今回のサンプルプログラムは

フォルダ内にあるExcelファイルの文字列を一括検索、一括置換する

イメージは以下です。

1.入力
◇設定

◇対象フォルダとファイル




2.出力

仕様概要は、以下の通りです。
1.設定シートの内容をチェックする
・値に間違いがないか
・対象ファルダが存在するかなど
2.対象フォルダのExcelを順次読み込み、指定文字列を検索・置換する
・検索の場合は上書き保存しない
・置換の場合には上書き保存する

Excelで作成したドキュメントですが、組織変更やニーズの変更などでドキュメントの中から、
・影響範囲を探して影響度合いを計る
・一括で特定の文字を変更したい
と言った場合を想定して作ってみました。

数少ないファイルであれば手で対応できますが、数多い場合に1つひとつファイルを開いて検索して内容を別Excelに転記するのはたいへんです。

サクラエディタのGrep検索は、テキストなどのファイルには対応できますが、Excelファイルでは想定通りに動作しませんでした。

プログラムの作成と実行

1.データ準備
1).検索・置換対象となるデータ
検索・置換のデータを[対象フォルダ]に作成し、Excelファイルを作成しておきます。

もしくは実際に試してみたいファイルがあれば、新たに作成した、万が一間違ってもよい対象フォルダにコピーし試します。

まずはお試しであり、いきなり本物の実データで操作しないで下さいね、今回は置換機能があり上書きしてしまいますので

使ってみて問題ないことを確認でき「問題なし」と判断しても、実務で使っているデータで一括置換する場合、必ず「置換前のデータをバックアップ」もしくは「新規に作成したフォルダにコピーしたファイルで実施」などリカバリできるようにしておくことは、これに限らず更新系作業では必要不可欠です。

正常に更新出来たことを確認できたら削除すればよいのですから。

2.Excelを起動
1).シート1(設定シート)に以下のデータを貼り付ける
ドラッグ&コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])

"操作指定
1:検索 2:置換"	"検索一致指定
1:部分 2:全体"	検索文字	"置換文字
置換の場合に有効"	対象フォルダ		
1	1	sample1		G:\TEST		

※注意 「置換」の場合はファイルを上書きします!						

出力の見出し						
フォルダ名	ファイル名	シート№	シート名	セル	置換前の内容	置換後の内容

崩れているように見えますが、1つのセルの中に改行があるためで、実際には想定通りに貼り付きます。

改行がある又は文字数が多いセルは貼り付けた後、セルの縦幅・横幅を広げると全体を表示できます。(広げないと隠れてしまっていて全体を見れません)

プログラムを実行する場合のフォルダ名や検索文字は、実際の環境に合わせて修正します。

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.Worksheets(1)
        strOper = .Cells(2, 1)
        strFind = .Cells(2, 2)
        strChr1 = .Cells(2, 3)
        strChr2 = .Cells(2, 4)
        strPath = .Cells(2, 5)
    End With
'起動した(この)ファイルのシート2をクリアし見出しをセット
    With excel1
        .Worksheets(2).Cells.Clear
        For iy1 = 1 To mds_max
            .Worksheets(2).Cells(1, iy1) = .Worksheets(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
'起動した(この)ファイルのシート2へセットするための添字に1を設定
    ix1 = 1
'対象フォルダから最初のファイル名を取得
    strFilename = Dir(strPath & cnsDIR, vbNormal)
'対象フォルダのファイル名を取得できなくなるまで繰り返す
    Do While strFilename <> ""
'取得したファイルをオープンすると同時し、変数:excl2へ設定
        Set excel2 = Workbooks.Open(strPath & "\" & strFilename)
'すべてのシート(Worksheets.Count)を処理する
        For cntSht = 1 To excel2.Worksheets.Count
'変数:wsへワークシートをセット
            Set ws = excel2.Worksheets(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
'起動した(この)ファイルのシート2へ項目をセットし、次の文字を検索する
            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.Worksheets(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.Worksheets(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:全体」の場合は指定した文字だけのセルが対象になります。

プログラムの詳細説明

処理対象フォルダからファイ名を取得し読み込む処理は、以下の記事を参照下さい。

Excel-VBA 実例 重複チェックして重複データを抽出する
こんにちは! 健史(たけふみ)です。 「Excelシートのある列項目が重複しているデータを探したい!」ということありませんか。 Excelの「COUNTIF 関数」を使えばできますが、処理データを現場にありそうなフォルダ情報から...

For文については、以下の記事を参照下さい。

Excel-VBA 実例 この通りやれば動く、とにかく触ってみよう
こんにちは! 健史(たけふみ)です。 パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。 この記事は、Exceは知っているけれど ・Excel-VBAって何? ・Excel-VBAは取っ付きにく...

範囲を指定して検索する処理は、以下の記事を参照下さい。

Excel-VBA 実例 テキストの文字列を検索し値を抽出
テキストファイルの中から件数など特定の文字列を確認していることありませんか。しかも毎日とか定期的に複数の項目を。ファイルを開いて見つけるのは面倒です。テキストファイルから特定の文字列をExcelシートに抽出するプログラムを作成してみました。

(このサイトを始めて訪れ当記事を目にされた方には恐縮ですが)これまで紹介してきたプログラムには無く新たに使ってみたものは
・2つのExcelファイルを同時に使う
・[With ~ End With]を使う
・[Sort]を使う
です。

最初に上記3つを補足してから、その他を補足します。

2つのExcelファイルを同時に使う

1つのExcelファイル内のシートを切り替えて参照する場合には、例えば

    If Worksheets(1).Cells(1, 1) = Worksheets(2).Cells(1, 1) Then ~

と記述し、複数のファイルを開いて処理する場合の「どのファイル」を使うかということは意識しません。(これまで紹介したプログラムは意識しませんでした)

2つのExcelファイルである、①設定シート・出力シート・VBAのプログラムを記述してあるファイル、②①の設定シートの内容から読み込んだファイル を同時に、例えば

    If ①のWorksheets(1).Cells(1, 1) = ②のWorksheets(2).Cells(1, 1) Then ~

というように処理する場合です。

やり方は参照したいファイルをプログラム内でオブジェクト、1つの物体というか物として定義して使用します。

これだけではわかりませんね、具体的に説明します。

2つ以上のファイルを同時に使いたい場合は、
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.①設定シート・出力シート・VBAのプログラムを記述してある最初に起動するファイルの場合

    Set excel1 = ThisWorkbook

です。

    Set excel1 = ActiveWorkbook

でもよいですが、処理を開始し②のファイルも開いた直後のファイルの場合は②がセットされます。

その場合は、他のファイルを開く前に記述します。

詳しくは以下を参照下さい。
参考:ThisWorkBookとActiveWorkBookの違い

3.参照する
Worksheets(x).Cells~の前にセットしたオブジェクト名を付けます。

    IF excel1.Worksheets(1).Cells(1,1) = 1 Then
       excel2.Worksheets(1).Cells(1,1) = excel1.Worksheets(1).Cells(1,2)
    End If

excel1.Worksheets(1).Cells(1,1)」のように。

[With ~ End With]を使う

以下の記述を例に説明します。

    With excel1.Worksheets(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.Worksheets(1).Cells(2, 1)
    strFind = excel1.Worksheets(1).Cells(2, 2)
    strChr1 = excel1.Worksheets(1).Cells(2, 3)
    strChr2 = excel1.Worksheets(1).Cells(2, 4)
    strPath = excel1.Worksheets(1).Cells(2, 5)

と同じです。

同じコーディング[excel1.Worksheets(1)]を各行で省略できます。

プログラムの記述量を少なくでき、コーディングミスのリスクを減らすことができ、量が少なければ見やすくなります。

1行であれば不要でしょうか、記述しても良いですかね、お好みで。

[Sort]を使う

出力シートの内容を[ファイル名][シート№][セル]をキーに昇順でソートしています。

    Header:=xlYes

は、1行目がヘッダー部でソート対象外とする場合に指定します。

今回ソートする理由は以下です。

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

で一括で置き換えています。

出力シートに記録する置換後の文字列処理で置き換えた内容をセットしても同じですが、多くの命令を試みるため敢えて変えました。

出力シートの見出し設定の補足

出力シートの見出しですが、設定シートの7行目に入力した値を設定しています。

何らかのデータ作成する場合は、何度実行しても良いように、何度実行しても出力するデータは「まっさら状態にしたシートに出力する」考えで作成しています。

今回プログラム内でダブルクォテーションで囲った見出しの文字列をセットするようにしていたのですが、プログラムの行数が長くなってしまったこともあり、設定シートにおいた値をセットするように変更してみました。

最後に

「EXCELファイルの文字列を一括で検索・置換するプログラム」でした。

テキストファイルの文字列を一括置換するプログラムは以下です。

Excel-VBA 実例 テキスト文書の文字列を一括置換
こんにちは! 健史(たけふみ)です。 手動で行う操作、例えば、 ・フォルダに保管されているテキストファイルを一つひとつ開く ・特定の文字列を検索して、あれば別の文字に変更する ・ファイルを上書きする を自動化したいということあ...

Wordファイルの文字列を一括置換するプログラムは以下です。

Excel-VBA 実例 Word文書の文字列を一括置換
こんにちは! 健史(たけふみ)です。 WORDファイルで保管されている文書の文字列、例えば ・組織変更によりマニュアルなどに記載されている部署名を一括で修正したい ・おのおの作成・修正された文書の'作成日'や'更新日'を揃えたい ...


手間の掛かる面倒かつ単純作業は機械やコンピュータで処理して、”判断”や"評価"など機械やコンピュータができない作業は人間が行うようにしたい、エネルギーを注ぎたいものです。

そんな思いから他のプログラムも記事にしています。

参考にして頂ければと思います。

EXCEL VBA
スポンサーリンク
- 面白かったらシェアお願いします! -
健史をフォローする
自分で改善

コメント