Excel VBAでExcelファイルをGrepする

Source

ExcelGrep (gist on GitHub)
https://gist.github.com/TatsuoWatanabe/2ed13d04d9dd686e9b23206c88a7e1a4

Download

ExcelGrep.xlsm (gist on GitHub)
https://gist.github.com/TatsuoWatanabe/2ed13d04d9dd686e9b23206c88a7e1a4/raw/7732a40d7c5bdaa50f4372d9a4681d0c404ce74d/ExcelGrep.xlsm

Image

Excelの検索機能との違い

• 指定フォルダ配下のExcelファイル(.xlsx .xls .xlsm)を全て検索します。

• 検索文字列を正規表現パターンで指定できます。

• 図形やテキストボックス内部のテキストも検索します。

概要

仕組みは単純です。

• 指定フォルダを再帰検索

• 該当ファイルをExcelで開く

• 全シートを検索

• シート内セルの値を正規表現で評価

• シート内図形のテキストを正規表現で評価

• 該当の値をリストアップ

という処理を行っています。

詳細

フォルダを再帰検索

ExcelGrep.cls

Private Sub SearchFolder(objFolder As Folder)
   If ShouldSearch = False Then Exit Sub
   
   Dim objFile   As File
   Dim SubFolder As Folder
   
   Call DisplayStatus(objFolder.Path)
   
   For Each objFile In objFolder.Files
       Select Case FSO.GetExtensionName(objFile.Path)
           Case "xls", "xlsx", "xlsm"
               Call SearchBook(objFile)
       End Select
   Next
   
   For Each SubFolder In objFolder.SubFolders
       Call SearchFolder(SubFolder) 'recursive call
   Next
End Sub

ファイルをExcelで開く(別インスタンス)

ExcelGrep.cls

Private Sub SearchBook(objFile As File)
   If ShouldSearch = False Then Exit Sub
   
   On Error Resume Next
   If InvisibleExcel Is Nothing Then
       Set InvisibleExcel = New Excel.Application
       InvisibleExcel.Visible = False
       InvisibleExcel.ScreenUpdating = False
   End If
   
   Dim Book As Workbook: Set Book = InvisibleExcel.Workbooks.Open(Filename:=objFile.Path, ReadOnly:=True)
   If Book Is Nothing Then
       MsgBox objFile.Path & vbCrLf & " が開けませんでした。"
       Exit Sub
   End If
   On Error GoTo 0
   
   Dim Sheet      As Worksheet
   For Each Sheet In Book.Worksheets
       Call SearchSheet(Sheet)
   Next
   
   Call Book.Close(SaveChanges:=False)
End Sub

シートを検索

ExcelGrep.cls

Private Sub SearchSheet(Sheet As Worksheet)
   If ShouldSearch = False Then Exit Sub
   
   Dim TargetRange As Range
   Dim Cell        As Range

   'Search Cells
   Set TargetRange = Sheet.UsedRange.Cells
   For Each Cell In TargetRange
       DoEvents
       Call DisplayStatus(Sheet.Parent.FullName)
       
       If Cell.Value <> "" Then
           If REG.Test(Cell.Value) Then
               Call ProcessCell(Cell)
           End If
       End If
   Next
   
   'Search Shapes
   Dim objShape As Shape
   For Each objShape In Sheet.Shapes
       DoEvents
       Call DisplayStatus(Sheet.Parent.FullName)
       
       If HasTextFrameCharactersText(objShape) Then
           If REG.Test(objShape.TextFrame.Characters.Text) Then
               Call ProcessShape(objShape)
           End If
       End If
   Next
End Sub

該当の値をリストアップ

ExcelGrep.cls

Private Sub SetNewRowData(FoundSheet As Worksheet, Name As String, Value As String)
   Dim Row      As Range: Set Row = GetNewRow()
   Dim PathCell As Range: Set PathCell = Row.Cells(ResultColumns.Path)
   Dim BookCell As Range: Set BookCell = Row.Cells(ResultColumns.Book)
   
   'パス
   PathCell.Value = FoundSheet.Parent.FullName
   PathCell.WrapText = False
   Call MainSheet.Hyperlinks.Add(Anchor:=PathCell, Address:=PathCell.Value)
   'ブック
   BookCell.Value = FoundSheet.Parent.Name
   Call MainSheet.Hyperlinks.Add(Anchor:=BookCell, Address:=PathCell.Value)
   'シート
   Row.Cells(ResultColumns.Sheet).Value = FoundSheet.Name
   '名前
   Row.Cells(ResultColumns.Name).Value = Name
   '値
   Row.Cells(ResultColumns.Value).Value = Value
   Row.Cells(ResultColumns.Value).WrapText = False
   '--- 罫線 ---
   Row.Borders.LineStyle = xlContinuous
End Sub

gist に全ソースがありますので、ご興味のおありの方はこちらをご参照ください。
https://gist.github.com/TatsuoWatanabe/2ed13d04d9dd686e9b23206c88a7e1a4/raw/7732a40d7c5bdaa50f4372d9a4681d0c404ce74d/ExcelGrep.xlsm