Excel文字列をオブジェクト内テキストも含めてサクッとgrep検索する手順作ってみました

ごあいさつ

こんにちは、「エイジ＠フジワーランド」です
フリーでパッケージシステムのOEM供給やってます、最近暇なので時給でSESやってます
新年は毎週1本は記事を書こうと思ってましたが、すでに1ヶ月が経ってしまいました…
目標を月に1記事投稿に変更します

Excel内文字列を検索する方法

SES作業中にあるキーワードが書かれた資料を探す必要があり、ExcelもGrepができたらいいなと思いVBAでちょっと作成してみました

要件

• 指定フォルダ内(サブフォルダも含めて)のExcelブックすべてを検索対象とする
• セルだけでなくオブジェクト内テキストも検索対象とする

Excelのオブジェクト構成は意外と奥が深い

ちょいちょいっと程なく完成したツール、オブジェクト内テキストまで検索できるとか超便利、とか思ってましたが、なぜか検索の対象にならないオブジェクトが頻出…
どうやらオブジェクトの中にオブジェクトがあったり、オブジェクトをグループ化したりとオブジェクト構成が奥深くなっている場合があることに気づきました

今回のポイント

オブジェクトがグループであればグループ内オブジェクトを対象とする処理を再帰呼び出しで実装しました
これでオブジェクト構成が深くてもすべてを検索対象とする要件が満たせるようになります

指定フォルダ内のExcelブックから文字列を検索する手順

ExcelのVBAマクロで実行しますが、VBAマクロは保存せず使い捨てでOKです

1.Excelを起動し新規作成で空白ブックを開く

2.新規ブックが開いたら Alt+F11 を押す

3.プロジェクトウィンドウで右クリック→挿入→標準モジュールを選択

4.以下のコードを貼り付ける

Public Sub SearchAllTextInFolder_AnyString()
    Dim s As String: s = InputBox("検索文字列:", "検索"): If s = "" Then Exit Sub
    Dim d As FileDialog: Set d = Application.FileDialog(msoFileDialogFolderPicker)
    If d.Show <> -1 Then Exit Sub
    Dim p As String: p = d.SelectedItems(1): If Right(p, 1) <> "\" Then p = p & "\"
    Dim w As Workbook: Set w = ThisWorkbook
    Dim r As Worksheet
    On Error Resume Next: Set r = w.Worksheets("検索結果"): On Error GoTo 0
    If r Is Nothing Then
        Set r = w.Worksheets.Add: r.Name = "検索結果"
    Else
        r.Cells.Clear
    End If
    r.[A1] = "フォルダ名": r.[B1] = "ファイル名": r.[C1] = "シート名": r.[D1] = "セル／オブジェクト名": r.[E1] = "テキスト内容"
    Dim n As Long: n = 2
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    ProcessFolder p, fso, r, n, s
    MsgBox "検索完了"
End Sub

Private Sub ProcessFolder(ByVal p As String, ByVal fso As Object, ByVal ws As Worksheet, ByRef n As Long, ByVal s As String)
    Dim fo, fi, sf
    Set fo = fso.GetFolder(p)
    For Each fi In fo.Files
        Dim x$: x = LCase(fso.GetExtensionName(fi.Name))
        If x Like "xls*" Then ProcessOneFile fi.Path, ws, n, s
    Next fi
    For Each sf In fo.SubFolders
        ProcessFolder sf.Path, fso, ws, n, s
    Next sf
End Sub

Private Sub ProcessOneFile(ByVal f As String, ByVal ws As Worksheet, ByRef n As Long, ByVal s As String)
    Dim wb As Workbook, pos As Long, folderName As String, fileName As String
    pos = InStrRev(f, "\")
    If pos > 0 Then
        folderName = Left(f, pos): fileName = Mid(f, pos + 1)
    Else
        folderName = "": fileName = f
    End If
    On Error Resume Next: Set wb = Workbooks.Open(f, ReadOnly:=True): If wb Is Nothing Then Exit Sub: On Error GoTo 0
    Dim sh As Worksheet, c As Range, rg As Range
    For Each sh In wb.Worksheets
        On Error Resume Next: Set rg = sh.UsedRange: On Error GoTo 0
        If Not rg Is Nothing Then
            For Each c In rg
                If (Not IsEmpty(c.Value)) And (Not IsError(c.Value)) Then
                    If InStr(1, c.Value, s, vbTextCompare) > 0 Then
                        WriteResult ws, folderName, fileName, sh.Name, c.Address, c.Value, n
                        n = n + 1
                    End If
                End If
            Next
        End If
        Dim sp As Shape
        For Each sp In sh.Shapes
            ExploreShape sp, folderName, fileName, sh.Name, ws, n, s
        Next
    Next
    wb.Close False
End Sub

Private Sub ExploreShape(ByVal sp As Shape, ByVal fld As String, ByVal fn As String, ByVal shn As String, ByVal ws As Worksheet, ByRef n As Long, ByVal s As String, Optional ByVal ps As String = "")
    Dim nm As String: nm = IIf(ps = "", sp.Name, ps & ">" & sp.Name)
    If sp.Type = msoGroup Then
        Dim sc As Shape
        For Each sc In sp.GroupItems: ExploreShape sc, fld, fn, shn, ws, n, s, nm: Next
    Else
        Dim t1 As String, t2 As String
        On Error Resume Next
        If sp.TextFrame.HasText Then t1 = sp.TextFrame.Characters.Text
        If sp.TextFrame2.HasText Then t2 = sp.TextFrame2.TextRange.Text
        On Error GoTo 0
        If InStr(1, t1, s, vbTextCompare) > 0 Then
            WriteResult ws, fld, fn, shn, nm & " (TextFrame)", t1, n: n = n + 1
        End If
        If t2 <> t1 And InStr(1, t2, s, vbTextCompare) > 0 Then
            WriteResult ws, fld, fn, shn, nm & " (TextFrame2)", t2, n: n = n + 1
        End If
    End If
End Sub

Private Sub WriteResult(ByVal ws As Worksheet, ByVal fd As String, ByVal fn As String, ByVal sn As String, ByVal cn As String, ByVal txt As String, ByVal nr As Long)
    With ws
        .Cells(nr, 1) = fd: .Cells(nr, 2) = fn: .Cells(nr, 3) = sn
        .Cells(nr, 4) = cn: .Cells(nr, 5) = txt
    End With
End Sub

5.メニューの実行→Sub/ユーザーフォームの実行を選択（ または F5押下 )

実行イメージ

1. 実行するとダイアログが出るので検索文字列を入力してください
   

2. フォルダ選択ダイアログ → 検索したいフォルダを選ぶ
   

3. しばらく処理が走り、完了後に「検索結果」シートが生成or更新
   ※サンプル画像は「選択」という文字列の検索結果です
   

   • フォルダ名 / ファイル名 / シート名 / セルまたはオブジェクト名 / テキスト内容
     という形で一覧を作成していますので、フィルタなども使いやすいと思います

補足

• テキスト検索は大文字小文字を区別しないようにしています
• ファイルを開くときに警告やリンク更新確認などで処理が止まるかもなので放置せずに実行終了まで見守ってください

おわりに

サクッと検索できましたでしょうか？どこかつまる所があればコメント等で教えていただけるとありがたいです

今回は検索でしたが、オブジェクト内の文字列が取得できるようになったので応用でテキスト差分比較とかもできそう…作成したら記事アップします

みなさんの作業効率が少しでもあがることを願います

最後まで読んできただきありがとうございました