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