そんなことしたら日が暮れるわ！！！
そう思いながら Excel ファイルをひとつひとつ探した。
そんなつらい思いをされた方もいるかもしれません。
また Excel ファイルというのは、外部ツール（たとえばサクラエディタの grep 機能など）で検索できません。
そんな状況で大量の Excel ファイル から文字検索するの～～～
ですが、そんな悩みも今日で解消です。
この度、サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロを作成しました！！
このページではサブフォルダ含むすべてのフォルダの Excel を文字検索するマクロの使い方と作成方法についてご紹介します。
もしよければ参考にしてみてください。
※ いつものようにつくったのも共有しときますので、よければどうぞ。
※ 2022/02/07 マクロに一部バグがあったので、修正しました。
「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の使い方
「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の使い方は下記になります。
- 検索ワードを入力する
- 検索ボタンを押下する
- フォルダダイアログが表示されるので、検索したいフォルダを選択する
これだけです。それでは実際にやってみるとします。
まず検索ワードを B3 セルになんでもいいのでいれます。
この時入力し忘れていれば、後の検索処理できないようになっています。
そして検索ボタンを押下します。
するとフォルダダイアログが表示されます。
ここでは検索先のフォルダを選択してOKをクリックします。
検索処理が実行され、検索結果が表示されます。
ここで「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の仕様について書いておきます。
- この検索処理は「.xls*」の拡張子がついているファイルに対して実行されます。
- Excel ファイルに保護がかかっている、もしくは非表示シートがある場合もその処理は検索対象となります。
- パスワード保護がかかっている Excel ファイルは読み込まれません。
「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の作り方
ここからプログラミングの少し難しい話になります！！
「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の作り方です。
今回は Excel VBA をつかって処理を実現しています。
処理の中身はこんな感じになっています。
- 定数と変数を定義
- 出力先シート「search」を初期化
- フォルダダイアログを表示してフォルダパスを取得
- 取得したフォルダパスをもとに Excel ファイル一覧を取得
- 取得した Excel ファイルを開き、Cells.Find をつかって文字を検索
- 検索結果をシートに出力
多いように見えますが、これを処理に起こせば「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」は実現できます。
定数と変数を定義
まずはこれらを VBA 処理上でよく使う定数と変数を定義します。
- SEARCH_WORD・・・検索するファイルの拡張子「\*.xls*」
- SHEET_OUTPUT・・・出力先のシート名「search」
- CELL_PRINT_COL・・・出力するシートの初期位置（列）、つまり１列目
- CELL_PRINT_ROW・・・出力するシートの初期位置（行）、つまり6行目
- CELL_SEARCH_WORD・・・検索ワードがあるセル、つまりＢ3セルを格納
- nowRow・・・変数、現在出力している行を格納
出力先シート「search」の初期化
つぎに出力先シート「search」を初期化する処理です。
これは出力する初期の列、行（つまり A6セル）から Excel の最終セルの範囲で値を削除します。
|
1 2 3 4 5 6 7 8 9 10 |
' シートの初期化 Private Sub reset() Application.ScreenUpdating = False Range(Cells(CELL_PRINT_ROW, CELL_PRINT_COL), Cells(Rows.Count, Columns.Count)).ClearContents Application.ScreenUpdating = True End Sub |
フォルダダイアログを表示してフォルダパスを取得
つぎにフォルダダイアログを表示させてフォルダパスを取得します。
フォルダダイアログっていうのはこれです↓
Application.FileDialog(msoFileDialogFolderPicker)を用いることで
フォルダダイアログで選択しその結果がフォルダパスが取得できます。
またキャンセルが押下された場合、そのまま処理が終了するように条件分岐しています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
Private Function getFolderName() Dim folderPath As Variant With Application.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then End End If folderPath = .SelectedItems(1) End With getFolderName = folderPath End Function |
取得したフォルダパスをもとに Excel ファイル一覧を取得
前章「フォルダダイアログを表示してフォルダパスを取得」で取得したフォルダパスしたパスをもとに
Excel ファイル一覧を取得します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
' 再帰的にファイルを検索 Private Sub searchFile(ByVal Path As String, ByRef myBook As Workbook) On Error Resume Next Dim buf As String, f As Object buf = Dir(Path & SEARCH_WORD) searchWord = Range(CELL_SEARCH_WORD) Do While buf <> "" Call grepExcel(searchWord, myBook, Path, buf) buf = Dir() Loop With CreateObject("Scripting.FileSystemObject") For Each f In .GetFolder(Path).SubFolders Call searchFile(f.Path, myBook) Next f End With End Sub |
フォルダパスの値が Path という変数に格納されていますが、これを Dir 関数に渡すことで
フォルダのフルパスが取得できます。
myBookとは今回作成するマクロ自体の情報を格納しています。
これをすることで検索結果出力先のシートをわかりやすくしています。
（検索結果を書き込む際に myBook を呼び出せば、間違えずに書き込むことができます）。
またサブフォルダを含めて計算するために再帰処理にしています。
つまり 上記の searchFile() が処理が完了した後にそのフォルダ内にサブフォルダがあれば、
もう一回 searchFile() を呼び出しています。
これをすることでフォルダ内にサブフォルダがなくなるまでずーっと処理が続くようになっています。
取得した Excel ファイルを開き、Cells.Find をつかって文字を検索
ここでは 前章「取得したフォルダパスをもとに Excel ファイル一覧を取得」で取得した
Excel ファイルをopen で開き、その開いたファイルのシート一つ一つに対して
Cells.Find をつかって文字検索を実施します。
この際に、文字検索結果が複数ある場合も考慮し、
Cells.FindNextをつかって次の検索文字がなくなるまでループ処理をします。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
' Excel ファイル内の文字検索 Private Sub grepExcel(ByVal searchWord, ByRef myBook As Workbook, ByVal Path As String, ByVal buf As String) Dim filePath Dim wb As Workbook Dim readSheet As Worksheet Dim Rng As Range Dim findResult fullPath = Path & "\" & buf Application.DisplayAlerts = False Application.ScreenUpdating = False Set wb = Workbooks.Open(Filename:=fullPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Password:="") If Err.Number = 1004 Then Err.Clear Else For Each mysheet In wb.Worksheets Set findResult = mysheet.Cells.Find(searchWord, LookAt:=xlPart) Dim findCell As Range Set findCell = findResult If Not (findCell Is Nothing) And Not (findResult Is Nothing) Then Do If Not (findCell Is Nothing) And Not (findResult Is Nothing) Then Call writeSheet(myBook, Path, buf, mysheet, findCell) Set findCell = mysheet.Cells.FindNext(findCell) If findCell Is Nothing Then Exit For End If Else Exit For End If Loop While findCell.Row <> findResult.Row End If Next End If wb.Close savechanges:=False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub |
パスワードつきExcel ファイルの無視する
ここでの処理で「If Err.Number = 1004 Then ～ 」というあまり見慣れないものがあると思います。
これはパスワードつきの Excel を開くときのエラーを無視するようにしています。
エラー1004コードを受け取った場合、Err.Clearとすることでエラーコードを削除します。
検索結果をシートに出力
最後に検索した結果が存在する場合、出力先のシート「search」に出力します。
このとき検索結果のセル位置が存在しない場合、出力しないように条件式を追加しています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
' 検索結果を出力 Private Sub writeSheet(ByRef myBook As Workbook, _ ByVal Path As String, _ ByVal buf As String, _ ByRef mysheet, _ ByRef findCell As Range) Dim outputSheet Dim outputCell Set outputSheet = myBook.Worksheets(SHEET_OUTPUT) outputCell = Split(Columns(findCell.Column).Address, "$")(2) & findCell.Column If outputCell <> "" Then outputSheet.Cells(nowRow, CELL_PRINT_COL) = buf outputSheet.Cells(nowRow, CELL_PRINT_COL + 1) = Path outputSheet.Cells(nowRow, CELL_PRINT_COL + 2) = mysheet.Name outputSheet.Cells(nowRow, CELL_PRINT_COL + 3) = outputCell nowRow = nowRow + 1 End If End Sub |
「サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロ」の全ソース
最後にソースコード全部を紹介します。
いままで長々と説明していましたが、これを貼り付ければ動きます。
また前章までの説明では「searchMacro()」がないと思いますが、これが今回のメイン処理です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 |
'================================================================================= ' フォルダ（サブフォルダ含む）内の Excel ブックの文字を検索するマクロ '================================================================================= Const SEARCH_WORD = "\*.xls*" Const SHEET_OUTPUT = "search" Const CELL_PRINT_COL = 1 Const CELL_PRINT_ROW = 6 Const CELL_SEARCH_WORD = "B3" Dim nowRow As Long ' メイン処理 Sub searchMacro() Dim buf As String Dim Path As String Dim myBook As Workbook nowRow = CELL_PRINT_ROW Set myBook = ThisWorkbook If Range(CELL_SEARCH_WORD) <> "" Then Path = getFolderName() Call reset Call searchFile(Path, myBook) If nowRow = CELL_PRINT_ROW Then MsgBox "検索結果：「" & Range(CELL_SEARCH_WORD) & "」が含まれるファイルはありませんでした。" Else MsgBox "検索結果：「" & Range(CELL_SEARCH_WORD) & "」が含まれるファイルが" & nowRow - CELL_PRINT_ROW & "件ヒットしました！" End If Else MsgBox "検索ワードを入力してください" End If End Sub ' シートの初期化 Private Sub reset() Application.ScreenUpdating = False Range(Cells(CELL_PRINT_ROW, CELL_PRINT_COL), Cells(Rows.Count, Columns.Count)).ClearContents Application.ScreenUpdating = True End Sub ' 再帰的にファイルを検索 Private Sub searchFile(ByVal Path As String, ByRef myBook As Workbook) On Error Resume Next Dim buf As String, f As Object buf = Dir(Path & SEARCH_WORD) searchWord = Range(CELL_SEARCH_WORD) Do While buf <> "" Call grepExcel(searchWord, myBook, Path, buf) buf = Dir() Loop With CreateObject("Scripting.FileSystemObject") For Each f In .GetFolder(Path).SubFolders Call searchFile(f.Path, myBook) Next f End With End Sub ' ダイアログでフォルダ名取得 Private Function getFolderName() Dim folderPath As Variant With Application.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then End End If folderPath = .SelectedItems(1) End With getFolderName = folderPath End Function ' Excel ファイル内の文字検索 Private Sub grepExcel(ByVal searchWord, ByRef myBook As Workbook, ByVal Path As String, ByVal buf As String) Dim filePath Dim wb As Workbook Dim readSheet As Worksheet Dim Rng As Range Dim findResult fullPath = Path & "\" & buf Application.DisplayAlerts = False Application.ScreenUpdating = False Set wb = Workbooks.Open(Filename:=fullPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Password:="") If Err.Number = 1004 Then Err.Clear Else For Each mysheet In wb.Worksheets Set findResult = mysheet.Cells.Find(searchWord, LookAt:=xlPart) Dim findCell As Range Set findCell = findResult If Not (findCell Is Nothing) And Not (findResult Is Nothing) Then Do If Not (findCell Is Nothing) And Not (findResult Is Nothing) Then Call writeSheet(myBook, Path, buf, mysheet, findCell) Set findCell = mysheet.Cells.FindNext(findCell) If findCell Is Nothing Then Exit For End If Else Exit For End If Loop While findCell.Row <> findResult.Row End If Next End If wb.Close savechanges:=False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub ' 検索結果を出力 Private Sub writeSheet(ByRef myBook As Workbook, _ ByVal Path As String, _ ByVal buf As String, _ ByRef mysheet, _ ByRef findCell As Range) Dim outputSheet Dim outputCell Set outputSheet = myBook.Worksheets(SHEET_OUTPUT) outputCell = Split(Columns(findCell.Column).Address, "$")(2) & findCell.Row If outputCell <> "" Then outputSheet.Cells(nowRow, CELL_PRINT_COL) = buf outputSheet.Cells(nowRow, CELL_PRINT_COL + 1) = Path outputSheet.Cells(nowRow, CELL_PRINT_COL + 2) = mysheet.Name outputSheet.Cells(nowRow, CELL_PRINT_COL + 3) = outputCell nowRow = nowRow + 1 End If End Sub |
最後に
いかがでしたでしょうか？
この記事では、サブフォルダ含むすべてのフォルダの Excel を文字検索するマクロについて解説しました。
これで大量のフォルダの中から膨大な Excel ブックを検索することは日々はなくなると思います。
この記事が読者の何かのお役に立てれば幸いです。
もしこの記事が良いと思ったら SNS とかでシェアしてもらえると嬉しいです。
ではでは。
