Excel全セル検索ツールをVBAで

はじめに

業務で「Excelのどこにこの単語があるのか分からない…」ということはありませんか？
複数のフォルダにまたがってファイルを探すのは、手作業だと非常に大変です。

今回紹介するVBAツールは、指定フォルダ（サブフォルダ含む）内のすべてのExcelブックを検索し、
ヒットしたセルの「ファイル名・シート名・セル番地・見出し列」を一覧化します。

⸻

特徴
• フォルダ単位の一括検索（サブフォルダ含む）
• 複数の検索ワードを一括指定可能
• 結果を1枚のUIシートに整形出力
• Nullや日付書式も安全に処理（Null/CVErr対策、日付は yyyy-mm-dd で統一）
• Excelのみで完結（外部DLL不要）

⸻

使い方
1. このコードを標準モジュールに貼り付けます。
2. run_BuildUI を実行すると、SearchUI という管理シートが自動生成されます。
3. C2 にフォルダパスを入力します。
4. C5 以降に検索したいキーワードを1行ずつ入力します。
5. 「Run Search」ボタンを押すだけ。

⸻

出力される情報

項目 内容
File (relative) サブフォルダ含むファイル名
Search Word 検索ワード
Sheet シート名
Cell セル番地
Header(Row1) その列の1行目の見出し

⸻

処理の流れ
1. 指定フォルダ以下のすべてのExcelファイルを再帰的に列挙
2. 各ブックを読み取り専用で開く
3. 全シート・全セルを UsedRange から配列に一括ロード
4. 各セルの値を to_検索用文字列 関数で安全に文字列化
5. 検索語ごとに InStr で照合
6. ヒットした情報をUIシートに追記

⸻

補足：to_検索用文字列 の役割

この小関数が本ツールの肝です。
• Null / Empty / #N/A などを安全に空文字扱い
• 日付セルは "yyyy-mm-dd" に整形
• その他は CStr で標準化

これにより、型エラーを起こさず、業務データを安定して検索できます。

⸻

想定シナリオ
• 過去の請求書や報告書から「特定の取引先名」を検索
• 大量のExcel定義書から「特定の列名」や「変数名」を抽出
• RPAやETLの影響範囲調査
• 仕様書群の横断的キーワード検索

⸻

注意点
• 大規模フォルダを対象にすると時間がかかります。
→ フィルタ条件を絞る・サブフォルダを分割するのがおすすめ。
• Excelが同時に他のマクロを実行中だと競合する場合があります。
• .xlsb なども対象に含まれます。不要なら collect_Excelファイル再帰 内の拡張子を調整してください。

⸻

おわりに

業務で「Excel全文検索が欲しい」と思ったときに、
自分で書ける・自分で改造できるのがVBAの強みです。

ぜひ社内利用・RPA補助・監査対応などに活用してみてください。
（コードは下に貼り付けてご利用ください）

Option Explicit

'========================
' Entry points (buttons)
'========================
Public Sub run_BuildUI()
    '=== UIシートを新規作成または再利用し見出しとボタン配置を行う ===
    Dim ws_UIシート As Worksheet
    On Error Resume Next
    Set ws_UIシート = ThisWorkbook.Worksheets("SearchUI")
    On Error GoTo 0
    
    If ws_UIシート Is Nothing Then
        Set ws_UIシート = ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
        ws_UIシート.Name = "SearchUI"
    Else
        ws_UIシート.Cells.Clear
    End If
    
    '=== UIシートのレイアウトを初期化する ===
    With ws_UIシート
        .Range("A1").Value = "Excel 全文検索ツール"
        .Range("B2").Value = "Base Folder:"
        .Range("C2").Value = ""
        .Range("B4").Value = "Search Words (one per row):"
        .Range("C4").Value = "← C5以降に1語/行で入力"
        
        .Range("A7").Value = "Results:"
        .Range("A8:E8").Value = Array("File (relative)", "Search Word", "Sheet", "Cell", "Header(Row1)")
        .Columns("A:E").ColumnWidth = 28
        .Rows("8:8").Font.Bold = True
    End With
    
    '=== UI操作用ボタンを配置する ===
    add_UIボタン ws_UIシート, "Pick Folder", "run_PickFolder", "E2", 120, 22
    add_UIボタン ws_UIシート, "Run Search", "run_SearchAll", "E4", 120, 28
    add_UIボタン ws_UIシート, "Clear Results", "run_ClearResults", "E5", 120, 22
    
    ws_UIシート.Activate
    MsgBox "SearchUI を準備しました。C2にフォルダ、C5以降に検索語を入力してください。", vbInformation
End Sub

Public Sub run_PickFolder()
    '=== フォルダ選択ダイアログを開いてパスを設定する ===
    Dim ws_UIシート As Worksheet: Set ws_UIシート = get_UIシート()
    Dim str_選択フォルダ As String: str_選択フォルダ = get_フォルダ選択パス()
    If Len(str_選択フォルダ) > 0 Then ws_UIシート.Range("C2").Value = str_選択フォルダ
End Sub

Public Sub run_ClearResults()
    '=== 既存の検索結果をクリアする ===
    Dim ws_UIシート As Worksheet: Set ws_UIシート = get_UIシート()
    Dim lng_最終行 As Long
    lng_最終行 = ws_UIシート.Cells(ws_UIシート.Rows.Count, "A").End(xlUp).Row
    If lng_最終行 > 8 Then ws_UIシート.Rows("9:" & lng_最終行).ClearContents
End Sub

Public Sub run_SearchAll()
    '=== 入力値を取得し前提条件を検証する ===
    Dim ws_UIシート As Worksheet: Set ws_UIシート = get_UIシート()
    
    Dim str_基準フォルダ As String
    str_基準フォルダ = Trim(CStr(ws_UIシート.Range("C2").Value))
    If Len(str_基準フォルダ) = 0 Then
        MsgBox "C2 に基準フォルダパスを入力してください。", vbExclamation
        Exit Sub
    End If
    If Right(str_基準フォルダ, 1) = "\" Then str_基準フォルダ = Left(str_基準フォルダ, Len(str_基準フォルダ) - 1)
    If Dir(str_基準フォルダ, vbDirectory) = "" Then
        MsgBox "フォルダが見つかりません: " & str_基準フォルダ, vbCritical
        Exit Sub
    End If
    
    '=== 検索語を取得してコレクション化する ===
    Dim col_検索語 As Collection
    Set col_検索語 = get_検索語コレクション(ws_UIシート)
    If col_検索語 Is Nothing Or col_検索語.Count = 0 Then
        MsgBox "検索ワードがありません。C5以降に1語/行で入力してください。", vbExclamation
        Exit Sub
    End If
    
    '=== 検索結果の表示領域を初期化する ===
    run_ClearResults
    
    '=== 対象フォルダ以下のExcelファイル一覧を再帰的に収集する ===
    Dim col_対象ファイル As Collection
    Set col_対象ファイル = New Collection
    collect_Excelファイル再帰 str_基準フォルダ, col_対象ファイル
    If col_対象ファイル.Count = 0 Then
        MsgBox "Excelファイルが見つかりません。", vbInformation
        Exit Sub
    End If
    
    '=== パフォーマンス向上のためアプリ設定を一時変更する ===
    Dim xl_計算モード As XlCalculation
    Dim bln_画面更新 As Boolean, bln_イベント As Boolean
    bln_画面更新 = Application.ScreenUpdating: Application.ScreenUpdating = False
    bln_イベント = Application.EnableEvents: Application.EnableEvents = False
    xl_計算モード = Application.Calculation: Application.Calculation = xlCalculationManual
    
    '=== 走査処理の初期値を設定する ===
    Dim lng_ファイルIndex As Long
    Dim wb_対象ブック As Workbook
    Dim lng_ヒット件数 As Long: lng_ヒット件数 = 0
    Dim lng_次行 As Long: lng_次行 = 9
    
    On Error GoTo CLEANUP
    
    '=== 各Excelファイルを順次開いて処理する ===
    For lng_ファイルIndex = 1 To col_対象ファイル.Count
        Dim str_フルパス As String: str_フルパス = CStr(col_対象ファイル(lng_ファイルIndex))
        Set wb_対象ブック = Workbooks.Open(Filename:=str_フルパス, ReadOnly:=True, UpdateLinks:=0, IgnoreReadOnlyRecommended:=True)
        
        '=== ブック内の全ワークシートを走査する ===
        Dim ws_対象シート As Worksheet
        For Each ws_対象シート In wb_対象ブック.Worksheets
            
            '=== シートの使用範囲を取得する（空シートはスキップ） ===
            Dim rng_使用範囲 As Range
            Set rng_使用範囲 = get_使用範囲_空対応(ws_対象シート)
            If Not rng_使用範囲 Is Nothing Then
                
                '=== 使用範囲を配列に読み込み高速に走査する ===
                Dim arr_値 As Variant
                arr_値 = rng_使用範囲.Value2
                
                '=== 配列の下限・上限を取得する ===
                Dim lng_行 As Long, lng_列 As Long
                Dim lng_行L As Long, lng_行U As Long, lng_列L As Long, lng_列U As Long
                lng_行L = LBound(arr_値, 1): lng_行U = UBound(arr_値, 1)
                lng_列L = LBound(arr_値, 2): lng_列U = UBound(arr_値, 2)
                
                '=== 各セルの文字列と検索語を照合する ===
                For lng_行 = lng_行L To lng_行U
                    For lng_列 = lng_列L To lng_列U
                        Dim str_セル文字列 As String
                        str_セル文字列 = to_検索用文字列( _
                            arr_値(lng_行, lng_列), _
                            ws_対象シート.Cells(rng_使用範囲.Row + lng_行 - 1, rng_使用範囲.Column + lng_列 - 1))
                        
                        If Len(str_セル文字列) > 0 Then
                            Dim str_検索語 As Variant
                            For Each str_検索語 In col_検索語
                                If InStr(1, str_セル文字列, CStr(str_検索語), vbTextCompare) > 0 Then
                                    
                                    '=== ヒット情報をUIに追記する ===
                                    Dim str_セル番地 As String
                                    str_セル番地 = ws_対象シート.Cells(rng_使用範囲.Row + lng_行 - 1, rng_使用範囲.Column + lng_列 - 1).Address(False, False)
                                    
                                    Dim str_相対パス As String
                                    str_相対パス = get_相対パス(str_基準フォルダ, str_フルパス)
                                    
                                    Dim str_見出し As String
                                    str_見出し = CStr(ws_対象シート.Cells(1, rng_使用範囲.Column + lng_列 - 1).Value)
                                    
                                    ws_UIシート.Cells(lng_次行, 1).Value = str_相対パス
                                    ws_UIシート.Cells(lng_次行, 2).Value = CStr(str_検索語)
                                    ws_UIシート.Cells(lng_次行, 3).Value = ws_対象シート.Name
                                    ws_UIシート.Cells(lng_次行, 4).Value = str_セル番地
                                    ws_UIシート.Cells(lng_次行, 5).Value = str_見出し
                                    
                                    lng_次行 = lng_次行 + 1
                                    lng_ヒット件数 = lng_ヒット件数 + 1
                                End If
                            Next str_検索語
                        End If
                    Next lng_列
                Next lng_行
            End If
        Next ws_対象シート
        
        '=== 開いたブックを保存せずに閉じる ===
        wb_対象ブック.Close SaveChanges:=False
        Set wb_対象ブック = Nothing
        DoEvents
    Next lng_ファイルIndex
    
CLEANUP:
    '=== エラー時や終了時の後処理を行う ===
    On Error Resume Next
    If Not wb_対象ブック Is Nothing Then wb_対象ブック.Close SaveChanges:=False
    Application.Calculation = xl_計算モード
    Application.EnableEvents = bln_イベント
    Application.ScreenUpdating = bln_画面更新
    On Error GoTo 0
    
    '=== 実行結果をメッセージで通知する ===
    ws_UIシート.Activate
    If lng_ヒット件数 = 0 Then
        MsgBox "検索完了。ヒットはありませんでした。", vbInformation
    Else
        MsgBox "検索完了。ヒット件数: " & lng_ヒット件数, vbInformation
    End If
End Sub

'========================
' Helpers
'========================
Private Function get_UIシート() As Worksheet
    '=== UIシートが無ければ作成し参照を返す ===
    On Error Resume Next
    Set get_UIシート = ThisWorkbook.Worksheets("SearchUI")
    On Error GoTo 0
    If get_UIシート Is Nothing Then
        run_BuildUI
        Set get_UIシート = ThisWorkbook.Worksheets("SearchUI")
    End If
End Function

Private Sub add_UIボタン(ByVal ws_配置先 As Worksheet, ByVal str_表示名 As String, ByVal str_マクロ名 As String, _
                          ByVal str_左上セル As String, ByVal sng_幅 As Single, ByVal sng_高さ As Single)
    '=== 指定位置にラウンド矩形ボタンを配置する ===
    Dim shp_ボタン As Shape
    On Error Resume Next
    ws_配置先.Shapes(str_表示名).Delete
    On Error GoTo 0
    Set shp_ボタン = ws_配置先.Shapes.AddShape(msoShapeRoundedRectangle, ws_配置先.Range(str_左上セル).Left, ws_配置先.Range(str_左上セル).Top, sng_幅, sng_高さ)
    With shp_ボタン
        .Name = str_表示名
        .TextFrame2.TextRange.Characters.Text = str_表示名
        .OnAction = "'" & ThisWorkbook.Name & "'!" & str_マクロ名
    End With
End Sub

Private Function get_フォルダ選択パス() As String
    '=== フォルダ選択ダイアログを表示して選択パスを返す ===
    Dim fd_フォルダ As FileDialog
    Set fd_フォルダ = Application.FileDialog(msoFileDialogFolderPicker)
    With fd_フォルダ
        .Title = "基準フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            get_フォルダ選択パス = .SelectedItems(1)
        Else
            get_フォルダ選択パス = ""
        End If
    End With
End Function

Private Function get_検索語コレクション(ByVal ws_UIシート As Worksheet) As Collection
    '=== C5以降の検索語を読み取りコレクション化する ===
    Dim col_語 As New Collection
    Dim lng_行 As Long, lng_最終行 As Long
    lng_最終行 = ws_UIシート.Cells(ws_UIシート.Rows.Count, "C").End(xlUp).Row
    For lng_行 = 5 To lng_最終行
        Dim str_語 As String
        str_語 = Trim(CStr(ws_UIシート.Cells(lng_行, "C").Value))
        If Len(str_語) > 0 Then col_語.Add str_語
    Next
    If col_語.Count = 0 Then
        Set get_検索語コレクション = Nothing
    Else
        Set get_検索語コレクション = col_語
    End If
End Function

Private Sub collect_Excelファイル再帰(ByVal str_基準 As String, ByRef col_ファイル As Collection)
    '=== 指定フォルダ以下からExcelファイルを再帰的に収集する ===
    Dim str_ファイル名 As String, str_サブ As String
    
    str_ファイル名 = Dir(str_基準 & "\*.xls*")
    Do While Len(str_ファイル名) > 0
        If Left(str_ファイル名, 2) <> "~$" Then col_ファイル.Add str_基準 & "\" & str_ファイル名
        str_ファイル名 = Dir
    Loop
    
    str_サブ = Dir(str_基準 & "\*", vbDirectory)
    Do While Len(str_サブ) > 0
        If str_サブ <> "." And str_サブ <> ".." Then
            If (GetAttr(str_基準 & "\" & str_サブ) And vbDirectory) = vbDirectory Then
                collect_Excelファイル再帰 str_基準 & "\" & str_サブ, col_ファイル
            End If
        End If
        str_サブ = Dir
    Loop
End Sub

Private Function get_相対パス(ByVal str_基準 As String, ByVal str_フルパス As String) As String
    '=== 基準フォルダからの相対パスを求める ===
    Dim str_基準末尾付 As String: str_基準末尾付 = str_基準
    If Right(str_基準末尾付, 1) <> "\" Then str_基準末尾付 = str_基準末尾付 & "\"
    If StrComp(Left(str_フルパス, Len(str_基準末尾付)), str_基準末尾付, vbTextCompare) = 0 Then
        get_相対パス = Mid(str_フルパス, Len(str_基準末尾付) + 1)
    Else
        get_相対パス = str_フルパス
    End If
End Function

Private Function get_使用範囲_空対応(ByVal ws_対象 As Worksheet) As Range
    '=== 使用範囲が空のシートはNothingを返す ===
    If Application.WorksheetFunction.CountA(ws_対象.Cells) = 0 Then
        Set get_使用範囲_空対応 = Nothing
    Else
        Set get_使用範囲_空対応 = ws_対象.UsedRange
    End If
End Function

'========================
' Value normalization
'========================
Private Function to_検索用文字列(ByVal v As Variant, Optional ByVal rng_元セル As Range = Nothing) As String
    '=== セル値を安全に文字列化する（Null/CVErr/Empty対策と日付の書式統一） ===
    If IsError(v) Or IsNull(v) Or IsEmpty(v) Then
        to_検索用文字列 = ""
        Exit Function
    End If
    
    '=== 日付っぽいかを判定して表示用書式に統一する ===
    Dim bln_日付形式 As Boolean
    If Not rng_元セル Is Nothing Then
        Dim str_書式 As String: str_書式 = LCase$(CStr(rng_元セル.NumberFormatLocal))
        bln_日付形式 = (InStr(str_書式, "y") > 0 Or InStr(str_書式, "m") > 0 Or InStr(str_書式, "d") > 0)
    Else
        bln_日付形式 = IsDate(v)
    End If
    
    If bln_日付形式 Then
        to_検索用文字列 = Format$(v, "yyyy-mm-dd")
    Else
        to_検索用文字列 = CStr(v)
    End If
End Function

⸻

タグ: Excel VBA 業務効率化 ツール作成 全文検索