FinTech Dialy

FinTech Diary

ソーシャルレンディング/ロボアドバイザー等のフィンテックを実際に利用した感想などを書いていますφ(..)

トップ > プログラミング > 【エクセル】エクセルGrep検索・Grep置換マクロ(複数文字列指定可能)【VBA】

【エクセル】エクセルGrep検索・Grep置換マクロ(複数文字列指定可能)【VBA】

プログラミング

あったらいいなと思っていたものを形にしました。
ここでいうGrepというのは、対象のエクセルから指定した文字列を含むセルの位置と内容を抽出することを言っています。

主な機能としては…
・複数文字列指定可能
・検索対象指定(数式/値/メモ/コメント)
・オプション指定(完全一致/大文字小文字区別/全角半角区別)
・対象拡張子指定(xlsx/xlsm/xls)
といった感じです。

ソースコードは長いので一番最後に貼り付けています。
不具合・考慮不足・改善点等あればご指摘頂けると幸いです。

ツールは下記からダウンロードできます。
[ダウンロードリンク]
drive.google.com

■同梱品
①エクセルGrep検索・Grep置換ツール.xlsm
　ツール本体です。
②エクセルGrep検索・Grep置換ツール操作説明書.xlsx
　操作説明です。使用前に必ずご一読下さい。
③エクセルGrep検索・Grep置換ツール機能仕様書.xlsx
　簡単ですが一応作成しました。おまけです。
④エクセルGrep検索・Grep置換ツール_テスト仕様書.xlsx
　こちらもおまけです。ざっくりですが挙動確認のテストを実施した際のテストケースと実施結果を記載しています。

マクロの種類

4種類のマクロがあります。
ファイル指定/フォルダ指定(サブフォルダ含む)でGrep検索/Grep置換を実施できます。
・Grep検索(ファイル指定)
・Grep検索(フォルダ指定)
・Grep置換(ファイル指定)
・Grep置換(フォルダ指定)

操作説明

どんな感じに動くのかざっくり説明します。 制約事項や注意点については操作説明書に諸々記載しているので、実際の使用に当たっては必ずそちらをご一読下さい。

1.Grep検索

「検索実行」シートにて操作を行います。

(1)検索条件指定

「検索実行」シートにて検索対象文字列と諸々の条件を指定します。
f:id:natsumedeus:20200926115240p:plain

(2)検索実行

①ファイル指定の場合
「検索実行(ファイル指定)」ボタンを押下して下さい。
ダイアログが表示されるので、対象のファイルを選択して下さい。選択したファイルに対して検索を実行します。
f:id:natsumedeus:20200926194719p:plain

②フォルダ指定の場合
「検索実行(フォルダ指定)」ボタンを押下して下さい。
ダイアログが表示されるので、対象のフォルダを選択して下さい。選択したフォルダ配下(サブフォルダ含む)のファイルに対して検索を実行します。
f:id:natsumedeus:20200926194829p:plain

(3)結果の確認

①検索結果の確認
「検索結果」シートに検索結果が出力されます。

f:id:natsumedeus:20200926194920p:plain
検索結果サンプル(ファイル指定)

②実行結果の確認
「検索実行」シートの「検索対象フォルダパス(自動記入欄)」「検索対象ファイル名(自動記入欄)」「検索実行結果(自動記入欄)」に実行結果が出力されます。

f:id:natsumedeus:20200926195055p:plain
検索実行結果サンプル(ファイル指定)

2.Grep置換

「置換実行」シートにて操作を行います。

(1)置換条件指定

「置換実行」シートにて置換対象文字列・置換後文字列と諸々の条件を指定します。
f:id:natsumedeus:20200926195722p:plain

(2)置換実行

①ファイル指定の場合
「置換実行(ファイル指定)」ボタンを押下して下さい。
ダイアログが表示されるので、対象のファイルを選択して下さい。選択したファイルに対して置換を実行します。
f:id:natsumedeus:20200926195810p:plain

②フォルダ指定の場合
「置換実行(フォルダ指定)」ボタンを押下して下さい。
ダイアログが表示されるので、対象のフォルダを選択して下さい。選択したフォルダ配下(サブフォルダ含む)のファイルに対して置換を実行します。
f:id:natsumedeus:20200926195933p:plain

(3)結果の確認

①置換結果の確認
「置換結果」シートに置換結果が出力されます。

f:id:natsumedeus:20200926212322p:plain
置換結果サンプル(フォルダ指定)

②実行結果の確認
「置換実行」シートの「置換対象フォルダパス(自動記入欄)」「置換対象ファイル名(自動記入欄)」「置換実行結果(自動記入欄)」に実行結果が出力されます。

f:id:natsumedeus:20200926200316p:plain
置換実行結果サンプル(フォルダ指定)

参考資料

主に参考にさせて頂いたサイトを記載します。

[参考]サブフォルダを含めてファイル一覧を取得する（Dir関数の再帰呼び出し） www.moug.net

[参考]条件に当てはまるセルを検索する(Find/FindNext/FindPreviousメソッド) www.moug.net

[参考]LookAt の定数を変数で指定するには？ okwave.jp

[参考]【ExcelVBA入門】セルをクリアする方法について徹底解説！ www.sejuku.net

[参考]【ExcelVBA】フォルダを選択するダイアログの使い方を徹底解説！ www.sejuku.net

[参考]【ExcelVBA】Integer型とLong型の使い分けは？処理速度が速いのは？ moripro.net

[参考]【Excel】他のセルや他のブックへのリンクを設定するマクロ hosopro.blogspot.com

改善点

①機能面
操作説明書に記載している制約や注意点は、改善できるものは改善したいですね。
特に、シート名に括弧があるとハイパーリンクが効かなくなるとか割と起こりそうなのでできれば何とかしたいですが…

②プログラム
下記の点に心残りがありますが、とりあえず機能的にやりたいことはできるようになったので、一旦リリースすることにしました。
・関数の統合
・固定値の定数化

③エクセルのバージョンがスレッドコメント未対応の場合、起動時にコンパイルエラーとなる
下記画像のようなエラーになります。
f:id:natsumedeus:20210223005059p:plain

以下の修正を行うことで、エラーは回避できるようになります(スレッドコメントをメモと同じ扱いにして回避)。
(1)エクセルを開いてALT+F11を押下し、コードを表示
(2)左側の標準モジュールから、「Excel_Grep_Replace」を選択し、定数定義(Constのかたまり)の一番下に以下の一行を追加
Const xlCommentsThreaded As Long = -4144 'スレッドコメント未対応版対策
f:id:natsumedeus:20210223010301p:plain (3)左側の標準モジュールから、「Excel_Grep_Search」を選択し、②と同様に修正
(4)Ctrl＋Sで保存

色々調べましたが、修正なしで回避する方法を見つけられませんでした。

所感

車輪の再発明？

探すと似たようなツールは既にいくつかあるのですが、(見つけられていないだけかもしれませんが)自分がやりたいと思っていたことができるものがなかったので、自分で作ることにしました。
既にあるツールを元に改修した方が早かったかもしれませんが、自分で一から作成することにしました。
若干車輪の再発明みたいになってるところはありますが、自分で考えて作った方が色々と勉強になるし、面白そうだと考えてのことです。

[参考]VBAでExcelファイルをGrep検索するマクロを書いてみた website-note.net

[参考]Excel VBAでExcelファイルをGrepする qiita.com

[参考]【Excel VBA】複数の単語をGrepする(1) fudebaco.com

連休と夏休みで久々にがっつりプログラミング

実は今週は連休に夏休み(9/23～9/25)を重ねて、9連休にしました。
偶然この時期に仕事が一区切りついたので、このタイミングで夏季休暇を取得できました。

4連休は何やってたのか既に覚えていませんが、蓄積した疲労で死んだ魚みたいに寝てたんだと思います。
4連休終わって夏休みに入ってからは多少気力が回復して、久々にがっつりプログラミングできました。
自分の好きなように開発するのは本当に楽しくて時間を忘れて没頭してしまいますね(すっかり昼夜逆転してしまいました…)。

設計からテストまで全部自分でできるのはやりがいがある

会社の仕事だと、設計だけ担当するとか、テストだけ担当するということが割とよくあるのですが、自分で作るものは最初から最後まで自分でできるのでより達成感や愛着を感じやすいところがあると思います。

職場の仲間や上司の有難みを実感した

会社の仕事だと、一人でやるということはなくて、必ずチームでの仕事になります。
設計書やプログラムを作成したら、必ずチームメンバーや上司、有識者のレビューを受けます。
そのレビューで散々叩かれて色々指摘を頂くことで、品質が向上します。

今回は誰のレビューを受けているわけでもないので、色々と考慮不足な点があるのではないか？という不安は正直あります。
やはり他人に見てもらう機会は重要だと、改めて実感しました。
その点、フリーランスで一人で仕事を請け負ってる方とかはその辺どうしてるんだろうとか、ちょっと気になったりしました。

おわりに

今回はここまでになります。
不具合・考慮不足・改善点等あればご指摘頂けると幸いです。

以上、宜しくお願い致します。

ソースコード

最後にソースコードを記載します。

1.Grep検索

Option Explicit

Const SEARCH_WORD_CLM As Long = 1 '検索対象語句記入列
Const SEARCH_METHOD_ROW As Long = 2 '検索対象記入行
Const SEARCH_METHOD_CLM As Long = 2 '検索対象記入列
Const OPTION_CLM As Long = 3 'オプション記入列
Const WHOLE_MATCH_ROW As Long = 5 '完全一致記入行
Const MATCH_CASE_ROW As Long = 6 '大文字小文字区別記入行
Const MATCH_BYTE_ROW As Long = 7 '全角半角区別記入行
Const SEARCH_FOLDER_PATH_CLM As Long = 5 '検索対象フォルダパス記入列
Const SEARCH_FILE_NAME_CLM As Long = 6 '検索対象ファイル名記入列
Const SEARCH_RESULT_CLM As Long = 7 '検索実行結果記入列

Dim configSht, resultSht, ws As Worksheet '検索実行シート・検索結果シート
Dim searchBookName As String '検索Book名
Dim result_row As Long  '結果記入行
Dim result_clm As Long  '結果記入列
Dim in_search_method As Long '検索対象
Dim in_look_at As Long '完全一致部分一致判定用
Dim in_match_case As Boolean '大文字小文字区別判定用
Dim in_match_byte As Boolean '全角半角区別判定用
Dim accept_xlsx As Boolean '拡張子判定用(xlsx)
Dim accept_xlsm As Boolean '拡張子判定用(xlsm)
Dim accept_xls As Boolean '拡張子判定用(xls)
Dim accept_extention As Boolean '拡張子判定結果
Dim path_cnt As Long 'ファイルパス取得用カウント
Dim folder_cnt As Long 'フォルダループ用カウント
Dim search_folder_path As String  '検索フォルダパス
Dim search_file_path As String '検索ファイルパス


Sub Folder_Search()

    Application.ScreenUpdating = False

    '初期設定
    Call Init_Params

    'フォルダ選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            End   'ダイアログでキャンセルボタンが押された場合は処理を終了
        End If
        search_folder_path = .SelectedItems(1)
    End With
    
    MsgBox "Start"

    '結果クリア
    Call Crear_Result

    '検索対象フォルダパス・検索対象ファイル名記入
    Call Get_File_Path(search_folder_path)

    'フォルダループ開始
    Do While configSht.Cells(folder_cnt, SEARCH_FOLDER_PATH_CLM) <> ""
        
        search_file_path = configSht.Cells(folder_cnt, SEARCH_FOLDER_PATH_CLM) & "\" & configSht.Cells(folder_cnt, SEARCH_FILE_NAME_CLM)
        
        '拡張子判定
        Call Extention_Check(search_file_path, accept_extention)
        If accept_extention Then
            Workbooks.Open search_file_path
            searchBookName = ActiveWorkbook.Name
            
            'Grep検索実行
            Call Grep_Search_Execute
            
            Workbooks(searchBookName).Close saveChanges:=False
            configSht.Cells(folder_cnt, SEARCH_RESULT_CLM).Value = "検索完了"
        Else
            configSht.Cells(folder_cnt, SEARCH_RESULT_CLM).Value = "拡張子が対象外のため検索対象外となりました"
        End If
        
        folder_cnt = folder_cnt + 1
    Loop
    'フォルダループ終了
    
    resultSht.Activate
    
    Application.ScreenUpdating = True
    
    MsgBox "End"

End Sub



Sub File_Search()

    Application.ScreenUpdating = False

    '初期設定
    Call Init_Params

    'ファイル選択
    search_file_path = Application.GetOpenFilename()
    If search_file_path = "False" Then   'ダイアログでキャンセルボタンが押された場合は処理を終了
        End
    End If

    '拡張子判定
    Call Extention_Check(search_file_path, accept_extention)
    If Not accept_extention Then
        MsgBox "拡張子が対象外のファイルです"
        End
    End If

    MsgBox "Start"

    '結果クリア
    Call Crear_Result

    Workbooks.Open search_file_path
    searchBookName = ActiveWorkbook.Name
    
    '検索対象フォルダパス・検索対象ファイル名記入
    configSht.Cells(2, SEARCH_FOLDER_PATH_CLM) = Workbooks(searchBookName).Path
    configSht.Cells(2, SEARCH_FILE_NAME_CLM) = Workbooks(searchBookName).Name

    'Grep検索実行
    Call Grep_Search_Execute

    Workbooks(searchBookName).Close saveChanges:=False
    configSht.Cells(2, SEARCH_RESULT_CLM).Value = "検索完了"
    resultSht.Activate
    
    Application.ScreenUpdating = True
    
    MsgBox "End"

End Sub

Sub Init_Params()
    
    '変数指定
    path_cnt = 1
    folder_cnt = 2
    result_row = 1
    result_clm = 1
    
    Set configSht = Workbooks("エクセルGrep検索・Grep置換ツール.xlsm").Worksheets("検索実行")
    Set resultSht = Workbooks("エクセルGrep検索・Grep置換ツール.xlsm").Worksheets("検索結果")

    'オプション設定
    '検索対象
    If configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "数式" Then
        in_search_method = xlFormulas
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "値" Then
        in_search_method = xlValues
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "メモ" Then
        in_search_method = xlNotes
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "コメント" Then
        in_search_method = xlCommentsThreaded
    End If
    '完全一致/部分一致
    If configSht.Cells(WHOLE_MATCH_ROW, OPTION_CLM) = "ON" Then
        in_look_at = xlWhole
    Else
        in_look_at = xlPart
    End If
    '大文字小文字区別
    If configSht.Cells(MATCH_CASE_ROW, OPTION_CLM) = "ON" Then
        in_match_case = True
    Else
        in_match_case = False
    End If
    '全角半角区別
    If configSht.Cells(MATCH_BYTE_ROW, OPTION_CLM) = "ON" Then
        in_match_byte = True
    Else
        in_match_byte = False
    End If

    '拡張子判定
    If configSht.Cells(10, OPTION_CLM) = "対象" Then
        accept_xlsx = True
    Else
        accept_xlsx = False
    End If
    
    If configSht.Cells(11, OPTION_CLM) = "対象" Then
        accept_xlsm = True
    Else
        accept_xlsm = False
    End If
    
    If configSht.Cells(12, OPTION_CLM) = "対象" Then
        accept_xls = True
    Else
        accept_xls = False
    End If

End Sub

Sub Crear_Result()
    
    '検索結果クリア
    resultSht.Activate
    If Not resultSht.Range("A2", Range("A2").SpecialCells(xlLastCell)).row = 1 Then
        resultSht.Range("A2", Range("A2").SpecialCells(xlLastCell)).ClearContents
    End If

    '検索対象フォルダパス・検索対象ファイル名クリア
    configSht.Activate
    If Not configSht.Range("E2", Range("E2").SpecialCells(xlLastCell)).row = 1 Then
        configSht.Range("E2", Range("E2").SpecialCells(xlLastCell)).ClearContents
    End If

End Sub

Sub Grep_Search_Execute()

    Dim searchResalt As Range '検索結果
    Dim search_word As String '検索対象語句
    Dim search_word_row As Long  '行(検索対象語句)
    Dim sheets_count As Long 'シート数
    Dim firstAddress As String '初回アドレス
    Dim first_search As Boolean '初回検索フラグ
    Dim searchSht As Worksheet '検索対象シート

    resultSht.Activate

    'シートループ開始
    For sheets_count = 1 To Workbooks(searchBookName).Sheets.Count
        Set searchSht = Workbooks(searchBookName).Worksheets(sheets_count)
        search_word_row = 2
        '検索判定ループ開始
        Do While configSht.Cells(search_word_row, SEARCH_WORD_CLM) <> ""
            search_word = configSht.Cells(search_word_row, SEARCH_WORD_CLM) '検索対象
            If TypeName(search_word) <> "Boolean" Then
                With searchSht.Cells
                    Set searchResalt = .Find(search_word, LookIn:=in_search_method, Lookat:=in_look_at, MatchCase:=in_match_case, MatchByte:=in_match_byte)
                    If Not searchResalt Is Nothing Then
                    
                        firstAddress = searchResalt.Address
                        first_search = True
                        
                        '検索実施ループ開始
                        Do
                            If Not first_search And searchResalt.Address = firstAddress Then
                                Exit Do
                            Else
                                result_row = result_row + 1
                                resultSht.Cells(result_row, result_clm).Value = search_word '検索対象語句
                                resultSht.Cells(result_row, result_clm + 1).Value = Workbooks(searchBookName).Path 'ファイルパス
                                resultSht.Cells(result_row, result_clm + 2).Value = Workbooks(searchBookName).Name 'ファイル名
                                resultSht.Cells(result_row, result_clm + 3).Value = searchSht.Name 'シート名
                                resultSht.Cells(result_row, result_clm + 4).Value = searchResalt.Address 'セル位置
                                resultSht.Cells(result_row, result_clm + 5).Value = searchResalt.Value 'セル内容(値)
                                resultSht.Cells(result_row, result_clm + 6).Value = searchResalt.Formula 'セル内容(数式)
                                'ハイパーリンク
                                resultSht.Hyperlinks.Add Anchor:=Cells(result_row, result_clm + 7), Address:=search_file_path, SubAddress:=searchSht.Name & "!" & searchResalt.Address
                            End If
                            
                            first_search = False
                            Set searchResalt = searchSht.Cells.FindNext(searchResalt)
                        Loop
                        '検索実施ループ終了
                        
                    End If
                End With
            End If
        search_word_row = search_word_row + 1
        Loop
        '検索判定ループ終了

    Next sheets_count
    'シートループ終了

End Sub



'[参考]サブフォルダを含めてファイル一覧を取得する（Dir関数の再帰呼び出し）
'https://www.moug.net/tech/exvba/0060088.html
Sub Get_File_Path(Path As String)
    Dim buf As String, f As Object
    buf = Dir(Path & "\*.*")
    Do While buf <> ""
        path_cnt = path_cnt + 1
        configSht.Cells(path_cnt, SEARCH_FOLDER_PATH_CLM).Value = Path
        configSht.Cells(path_cnt, SEARCH_FILE_NAME_CLM).Value = buf
        buf = Dir()
    Loop
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(Path).SubFolders
            Call Get_File_Path(f.Path)
        Next f
    End With
End Sub

'[参考]拡張子を確実に取得する
'https://www.moug.net/tech/exvba/0060053.html
Sub Extention_Check(targetPath As String, extention_check_result As Boolean)
    Dim extensionData As String
    Dim periodPosition As Long
    
    periodPosition = InStrRev(targetPath, ".")
    extensionData = LCase(Mid(targetPath, periodPosition + 1))
    
    extention_check_result = False
    
    If accept_xlsx And extensionData = "xlsx" Then
        extention_check_result = True
    End If
    If accept_xlsm And extensionData = "xlsm" Then
        extention_check_result = True
    End If
    If accept_xls And extensionData = "xls" Then
        extention_check_result = True
    End If
    
End Sub

2.Grep置換

Option Explicit

Const SEARCH_WORD_CLM As Long = 1 '置換対象語句記入列
Const REPLACE_WORD_CLM As Long = 2 '置換後の語句記入列
Const SEARCH_METHOD_ROW As Long = 2 '検索対象記入行
Const SEARCH_METHOD_CLM As Long = 3 '検索対象記入列
Const OPTION_CLM As Long = 4 'オプション記入列
Const WHOLE_MATCH_ROW As Long = 5 '完全一致記入行
Const MATCH_CASE_ROW As Long = 6 '大文字小文字区別記入行
Const MATCH_BYTE_ROW As Long = 7 '全角半角区別記入行
Const SEARCH_FOLDER_PATH_CLM As Long = 6 '検索対象フォルダパス記入列
Const SEARCH_FILE_NAME_CLM As Long = 7 '検索対象ファイル名記入列
Const SEARCH_RESULT_CLM As Long = 8 '検索実行結果記入列

Dim configSht, resultSht, ws As Worksheet '検索実行シート・検索結果シート
Dim searchBookName As String '検索Book名
Dim result_row As Long  '結果記入行
Dim result_clm As Long  '結果記入列
Dim in_search_method As Long '検索対象
Dim in_look_at As Long '完全一致部分一致判定用
Dim in_match_case As Boolean '大文字小文字区別判定用
Dim in_match_byte As Boolean '全角半角区別判定用
Dim accept_xlsx As Boolean '拡張子判定用(xlsx)
Dim accept_xlsm As Boolean '拡張子判定用(xlsm)
Dim accept_xls As Boolean '拡張子判定用(xls)
Dim accept_extention As Boolean '拡張子判定結果
Dim path_cnt As Long 'ファイルパス取得用カウント
Dim folder_cnt As Long 'フォルダループ用カウント
Dim search_folder_path As String  '検索フォルダパス
Dim search_file_path As String '検索ファイルパス


Sub Folder_Replace()

    Application.ScreenUpdating = False

    '初期設定
    Call Init_Params

    'フォルダ選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            End   'ダイアログでキャンセルボタンが押された場合は処理を終了
        End If
        search_folder_path = .SelectedItems(1)
    End With
    
    MsgBox "Start"

    '結果クリア
    Call Crear_Result

    '検索対象フォルダパス・検索対象ファイル名記入
    Call Get_File_Path(search_folder_path)

    'フォルダループ開始
    Do While configSht.Cells(folder_cnt, SEARCH_FOLDER_PATH_CLM) <> ""
        
        search_file_path = configSht.Cells(folder_cnt, SEARCH_FOLDER_PATH_CLM) & "\" & configSht.Cells(folder_cnt, SEARCH_FILE_NAME_CLM)
        
        '拡張子判定
        Call Extention_Check(search_file_path, accept_extention)
        If accept_extention Then
            Workbooks.Open search_file_path
            searchBookName = ActiveWorkbook.Name
            
            'Grep置換実行
            Call Grep_Replace_Execute
            
            Workbooks(searchBookName).Close saveChanges:=True
            configSht.Cells(folder_cnt, SEARCH_RESULT_CLM).Value = "置換完了"
        Else
            configSht.Cells(folder_cnt, SEARCH_RESULT_CLM).Value = "拡張子が対象外のため置換対象外となりました"
        End If
        
        folder_cnt = folder_cnt + 1
    Loop
    'フォルダループ終了
    
    resultSht.Activate
    
    Application.ScreenUpdating = True
    
    MsgBox "End"

End Sub



Sub File_Replace()

    Application.ScreenUpdating = False

    '初期設定
    Call Init_Params

    'ファイル選択
    search_file_path = Application.GetOpenFilename()
    If search_file_path = "False" Then   'ダイアログでキャンセルボタンが押された場合は処理を終了
        End
    End If

    '拡張子判定
    Call Extention_Check(search_file_path, accept_extention)
    If Not accept_extention Then
        MsgBox "拡張子が対象外のファイルです"
        End
    End If

    MsgBox "Start"

    '結果クリア
    Call Crear_Result

    Workbooks.Open search_file_path
    searchBookName = ActiveWorkbook.Name
    
    '検索対象フォルダパス・検索対象ファイル名記入
    configSht.Cells(2, SEARCH_FOLDER_PATH_CLM) = Workbooks(searchBookName).Path
    configSht.Cells(2, SEARCH_FILE_NAME_CLM) = Workbooks(searchBookName).Name

    'Grep置換実行
    Call Grep_Replace_Execute

    Workbooks(searchBookName).Close saveChanges:=True
    configSht.Cells(2, SEARCH_RESULT_CLM).Value = "置換完了"
    resultSht.Activate

    Application.ScreenUpdating = True

    MsgBox "End"

End Sub

Sub Init_Params()
    
    '変数指定
    path_cnt = 1
    folder_cnt = 2
    result_row = 1
    result_clm = 1
    
    Set configSht = Workbooks("エクセルGrep検索・Grep置換ツール.xlsm").Worksheets("置換実行")
    Set resultSht = Workbooks("エクセルGrep検索・Grep置換ツール.xlsm").Worksheets("置換結果")

    'オプション設定
    '検索対象
    If configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "数式" Then
        in_search_method = xlFormulas
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "値" Then
        in_search_method = xlValues
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "メモ" Then
        in_search_method = xlNotes
    ElseIf configSht.Cells(SEARCH_METHOD_ROW, SEARCH_METHOD_CLM) = "コメント" Then
        in_search_method = xlCommentsThreaded
    End If
    '完全一致/部分一致
    If configSht.Cells(WHOLE_MATCH_ROW, OPTION_CLM) = "ON" Then
        in_look_at = xlWhole
    Else
        in_look_at = xlPart
    End If
    '大文字小文字区別
    If configSht.Cells(MATCH_CASE_ROW, OPTION_CLM) = "ON" Then
        in_match_case = True
    Else
        in_match_case = False
    End If
    '全角半角区別
    If configSht.Cells(MATCH_BYTE_ROW, OPTION_CLM) = "ON" Then
        in_match_byte = True
    Else
        in_match_byte = False
    End If

    '拡張子判定
    If configSht.Cells(10, OPTION_CLM) = "対象" Then
        accept_xlsx = True
    Else
        accept_xlsx = False
    End If
    
    If configSht.Cells(11, OPTION_CLM) = "対象" Then
        accept_xlsm = True
    Else
        accept_xlsm = False
    End If
    
    If configSht.Cells(12, OPTION_CLM) = "対象" Then
        accept_xls = True
    Else
        accept_xls = False
    End If

End Sub

Sub Crear_Result()
    
    '検索結果クリア
    resultSht.Activate
    If Not resultSht.Range("A2", Range("A2").SpecialCells(xlLastCell)).row = 1 Then
        resultSht.Range("A2", Range("A2").SpecialCells(xlLastCell)).ClearContents
    End If

    '検索対象フォルダパス・検索対象ファイル名クリア
    configSht.Activate
    If Not configSht.Range("F2", Range("F2").SpecialCells(xlLastCell)).row = 1 Then
        configSht.Range("F2", Range("F2").SpecialCells(xlLastCell)).ClearContents
    End If

End Sub

Sub Grep_Replace_Execute()

    Dim searchResalt As Range '検索結果
    Dim search_word As String '検索対象語句
    Dim search_word_row As Long  '行(検索対象語句)
    Dim sheets_count As Long 'シート数
    Dim firstAddress As String '初回アドレス
    Dim first_search As Boolean '初回検索フラグ
    Dim searchSht As Worksheet '検索対象シート
    Dim replace_word As String '置換対象語句
    Dim wk_replace_value As String '置換用変数

    resultSht.Activate

    'シートループ開始
    For sheets_count = 1 To Workbooks(searchBookName).Sheets.Count
        Set searchSht = Workbooks(searchBookName).Worksheets(sheets_count)
        search_word_row = 2
        '検索判定ループ開始
        Do While configSht.Cells(search_word_row, SEARCH_WORD_CLM) <> ""
            search_word = configSht.Cells(search_word_row, SEARCH_WORD_CLM) '置換対象
            replace_word = configSht.Cells(search_word_row, REPLACE_WORD_CLM) '置換後
            If TypeName(search_word) <> "Boolean" Then
                With searchSht.Cells
                    Set searchResalt = .Find(search_word, LookIn:=in_search_method, Lookat:=in_look_at, MatchCase:=in_match_case, MatchByte:=in_match_byte)
                    If Not searchResalt Is Nothing Then
                    
                        firstAddress = searchResalt.Address
                        first_search = True
                        
                        '検索実施ループ開始
                        Do
                            If Not first_search And searchResalt.Address = firstAddress Then
                                Exit Do
                            Else
                                result_row = result_row + 1
                                resultSht.Cells(result_row, result_clm).Value = search_word '検索対象語句
                                resultSht.Cells(result_row, result_clm + 1).Value = replace_word '置換後語句
                                resultSht.Cells(result_row, result_clm + 2).Value = Workbooks(searchBookName).Path 'ファイルパス
                                resultSht.Cells(result_row, result_clm + 3).Value = Workbooks(searchBookName).Name 'ファイル名
                                resultSht.Cells(result_row, result_clm + 4).Value = searchSht.Name 'シート名
                                resultSht.Cells(result_row, result_clm + 5).Value = searchResalt.Address 'セル位置
                                resultSht.Cells(result_row, result_clm + 6).Value = searchResalt.Formula 'セル内容(置換前)
                                '置換実施
                                wk_replace_value = searchResalt.Formula
                                searchSht.Cells(searchResalt.row, searchResalt.column).Formula = Replace(wk_replace_value, search_word, replace_word, , , vbTextCompare)
                                resultSht.Cells(result_row, result_clm + 7).Value = searchResalt.Formula 'セル内容(置換後)
                                'ハイパーリンク
                                resultSht.Hyperlinks.Add Anchor:=Cells(result_row, result_clm + 8), Address:=search_file_path, SubAddress:=searchSht.Name & "!" & searchResalt.Address
                            End If
                            
                            first_search = False
                            Set searchResalt = searchSht.Cells.FindNext(searchResalt)
                            
                            '置換後の再検索抑止
                            If searchResalt Is Nothing Then
                                Exit Do
                            End If
                            
                        Loop
                        '検索実施ループ終了
                        
                    End If
                End With
            End If
        search_word_row = search_word_row + 1
        Loop
        '検索判定ループ終了

    Next sheets_count
    'シートループ終了

End Sub



'[参考]サブフォルダを含めてファイル一覧を取得する（Dir関数の再帰呼び出し）
'https://www.moug.net/tech/exvba/0060088.html
Sub Get_File_Path(Path As String)
    Dim buf As String, f As Object
    buf = Dir(Path & "\*.*")
    Do While buf <> ""
        path_cnt = path_cnt + 1
        configSht.Cells(path_cnt, SEARCH_FOLDER_PATH_CLM).Value = Path
        configSht.Cells(path_cnt, SEARCH_FILE_NAME_CLM).Value = buf
        buf = Dir()
    Loop
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(Path).SubFolders
            Call Get_File_Path(f.Path)
        Next f
    End With
End Sub

'[参考]拡張子を確実に取得する
'https://www.moug.net/tech/exvba/0060053.html
Sub Extention_Check(targetPath As String, extention_check_result As Boolean)
    Dim extensionData As String
    Dim periodPosition As Long
    
    periodPosition = InStrRev(targetPath, ".")
    extensionData = LCase(Mid(targetPath, periodPosition + 1))
    
    extention_check_result = False
    
    If accept_xlsx And extensionData = "xlsx" Then
        extention_check_result = True
    End If
    If accept_xlsm And extensionData = "xlsm" Then
        extention_check_result = True
    End If
    If accept_xls And extensionData = "xls" Then
        extention_check_result = True
    End If
    
End Sub