この記事を読むのに必要な時間は約 6 分です。
たくさんのファイルの中身をまとめて検索するには、Grepですよね。
サクラエディタや秀丸エディタなど、エディタに付いている機能の１つです。
でもサクラエディタなどでExcelファイルをGrepしても、まともに探すことが出来ません。
バイナリデータだから・・・。
なので、ExcelファイルもGrep出来るツールがあります。
ところが、そんな便利ツールもセキュリティにうるさい企業だと、ダウンロードして自分のPCに入れることが禁止されていたりします。
数千もあるExcelを一つひとつ開いて検索するのはイヤですよね。
そんな職場でもExcelファイルをGrepしたい！！
というわけで、Excel VBAのマクロでGrepツールが作れるので書いてみました。
目次
Excel VBAでGrepするとこんな感じ
検索対象のフォルダとキーワードを指定して「ExcelGrep」ボタンを押してGrepします。
キーワードを含むセルが一覧に表示されます。
Grep検索マクロでやっていること
Excel Grepマクロの中でやっていることはシンプルです。
- エラーチェック
- 一覧をクリア
- 指定したパス内のExcelファイルを全検索
- サブフォルダも再帰的にファイル検索
- 見つかったExcelファイルの各シートから、キーワードに一致する文字列を全検索
- 見つかったら、その都度キーワードを含むセルの内容を一覧に記載
- 罫線を引く
片っ端からExcelファイルを開いて検索を繰り返して、見つかる度にセルの位置や内容を一覧に書いていく、ただそれだけです。
Grepのソースコード
シートに入れるGrepボタンと、ボタンをクリックしたとき動作するものとだけ分けて書きました。
このソースコードでGrepを試してみたいとき、やり方が分からない場合は
の記事が見本になります。
ボタンの入れ方やソースコードをどこに貼り付けるのか、参考にしてみてください。
シートの枠
下の表は、”Grep”シートのものです。
Ａ１セルから貼り付けて、セルの幅を調整すれば大丈夫です。
|
|
|||||||
| ExcelファイルをGrepするマクロ | |||||||
| ルートパス | |||||||
|---|---|---|---|---|---|---|---|
| キーワード | |||||||
| No | パス | ファイル名 | シート名 | セル位置 | セル内容 | ||
貼り付ければ下図のようなセルの配置になります。
シート側
ボタンを作って右クリックから、ソースコードの表示をすれば、ボタンをクリックしたときの処理が勝手に出来ます。
そこから「Call grepMain」でメイン関数を呼びます。
|
1 2 3 |
Private Sub GrepButton_Click() Call grepMain End Sub |
Grepのメイン
基本的にそのまま貼り付けて貰えば大丈夫ですが、３か所だけ注意点があります。
- ３行目にシート名を書いています。”Grep”というところが実際のシート名と一致している必要があります。
- １５行目に検索対象のフォルダのパスを書いています。セルの位置と一致する必要があります。
- １６行目にキーワードを書いています。これもセルの位置と一致する必要があります。
|
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 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 |
Option Explicit Public Const STR_GREP_SHEET_NAME As String = "Grep" Public sMsgString As String Public sFilePathRoot As String Public sKeyWord As String Public lcnt As Long 'Grepメイン関数 Public Sub grepMain() Dim bErrFlag As Boolean bErrFlag = False sFilePathRoot = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(4, 5).Value sKeyWord = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(5, 5).Value 'エラーチェック bErrFlag = inputCheck If bErrFlag = False Then '描画をいったんオフ Application.ScreenUpdating = False '一覧をクリア Call clearCells If Right(sFilePathRoot, 1) <> "\" Then sFilePathRoot = sFilePathRoot & "\" End If lcnt = 8 'ExcelファイルのGrep Call openExcelFiles(sFilePathRoot) '罫線を引く Call addLines '描画をオン Application.ScreenUpdating = True sMsgString = "Grepが完了しました！！" End If 'メッセージ出力 MsgBox sMsgString End Sub '入力内容チェック Private Function inputCheck() As Boolean inputCheck = False If sKeyWord = "" Then sMsgString = "キーワードが入力されていません" inputCheck = True End If End Function '指定したフォルダ内のエクセルファイルを全検索 Private Sub openExcelFiles(ByVal sFilePath As String) Dim lSheetNo As Long Dim sTmpPath As String Dim oFSO As Object If Right(sFilePath, 1) <> "\" Then sFilePath = sFilePath & "\" End If 'Dirで見つかったファイル名を取得 sTmpPath = Dir(sFilePath & "*.xls") '同じフォルダ内でエクセルファイルが見つかる限り検索 Do While sTmpPath <> "" '読み取り専用、更新なしで開く Workbooks.Open sFilePath & sTmpPath, UpdateLinks:=0, ReadOnly:=1 '全シートループ For lSheetNo = 1 To Worksheets.Count 'シート内をGrep Call grepExcelSheet(sFilePath, sTmpPath, lSheetNo) Next lSheetNo Workbooks(sTmpPath).Close sTmpPath = Dir() Loop 'この関数自身を呼び出して、サブフォルダも再帰的に検索 With CreateObject("Scripting.FileSystemObject") For Each oFSO In .GetFolder(sFilePath).SubFolders Call openExcelFiles(oFSO.Path) Next oFSO End With Set oFSO = Nothing End Sub 'Excelのシート内をGrep Private Sub grepExcelSheet(ByVal sFilePath As String, ByVal sTmpPath As String, ByVal lSheetNo As Long) Dim lCellRow As Long, lCellCol As Long Dim rFoundCell As Range, rFoundFirstCell As Range Dim rEndRange As Range Dim rTmpFoundCell As Range Dim sTmpSheetName As String With Workbooks(sTmpPath).Sheets(lSheetNo) 'シート内1件目に見つかったセルを取得 Set rTmpFoundCell = .Cells.Find(What:=sKeyWord, LookAt:=xlPart) '見つからなかったら関数を抜ける If rTmpFoundCell Is Nothing Then Exit Sub 'シート名を取得 sTmpSheetName = .Name '最初に見つかったセル情報を保持 Set rFoundFirstCell = rTmpFoundCell Do '見つかったセルの情報を一覧に記載 Call outputCellInfo(sTmpPath, sFilePath, sTmpSheetName, rTmpFoundCell) 'シート内2件目以降に一致したやつ Set rTmpFoundCell = .Cells.FindNext(rTmpFoundCell) '見つかったセルが最初に見つかったセルと異なる間ループ Loop While rTmpFoundCell <> rFoundFirstCell End With End Sub 'キーワードを含むセルの情報をアウトプット Private Sub outputCellInfo(ByVal sTmpPath As String, ByVal sFilePath As String, ByVal sTmpSheetName As String, _ ByVal rFoundCell As Range) With ThisWorkbook.Sheets(STR_GREP_SHEET_NAME) 'No .Cells(lcnt, 2).Value = lcnt - 7 'パス .Cells(lcnt, 3).Value = sFilePath 'ファイル名 .Cells(lcnt, 4).Value = sTmpPath 'シート名 .Cells(lcnt, 5).Value = sTmpSheetName 'セルの位置 .Cells(lcnt, 6).Value = convertRange(rFoundCell.Column) & rFoundCell.Row 'キーワードを含むセルの内容 .Cells(lcnt, 7).Value = rFoundCell.Value End With '次の行に繰り上げる lcnt = lcnt + 1 End Sub 'セルの位置を変換 Private Function convertRange(ByVal lCol As Long) As String convertRange = "" Dim lTmpCol As Long Dim lBuf As Long Dim sAsc As Long sAsc = 64 If Len(lCol) = 0 Then Exit Function lTmpCol = lCol '1桁目を変換 lBuf = sAsc + lTmpCol Mod 26 convertRange = Chr(lBuf) lTmpCol = lTmpCol \ 26 '2桁目を変換 If lTmpCol Mod 26 >= 1 Then lBuf = sAsc + lTmpCol Mod 26 convertRange = Chr(lBuf) & convertRange End If '3桁目を変換 If lTmpCol \ 26 >= 1 Then lBuf = sAsc + lTmpCol \ 26 convertRange = Chr(lBuf) & convertRange End If End Function '罫線を引く Private Sub addLines() Dim lRow As Long '8行目以降を選択 lRow = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(Rows.Count, 2).End(xlUp).Row '0件の場合は罫線を引かない If lRow < 8 Then Exit Sub Range("B8:G" & lRow).Select '最初に通常の罫線を引く With Selection.Borders() .LineStyle = xlContinuous .Weight = xlThin End With '内側の横方向の罫線だけ点線にする With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlHairline End With Range("A1").Select End Sub 'セルをクリア Private Sub clearCells() '7行以下ならクリアしない If ActiveCell.SpecialCells(xlLastCell).Row < 8 Then Exit Sub End If '8行目以降をクリア Range("B8", ActiveCell.SpecialCells(xlLastCell)).Select Selection.Borders().LineStyle = xlLineStyleNone Selection.ClearFormats Selection.ClearContents Range("A1").Select End Sub |
まとめ：VBAでExcelファイルをGrep検索するマクロ
ExcelファイルのGrepマクロでした。
誰かが作ったGrepのツールをダウンロード出来れば手っ取り早いと思いますが、セキュリティのためインターネットに繋がっていない職場もあったりします。
そんな時、ツールを自作出来れば便利ですよね。
自作と言っても、誰かが公開しているソースコードを見ながらそのまま書き込んで作るだけです。
よろしければ参考にどうぞ。
