【Excel VBA】Excelファイルコーパス（Corpus）

複数のExcelファイルを対象に指定した文字列を串刺し検索し、結果をリスト形式で一覧表示するExcel VBAのサンプルコードと手順を解説します。

1. この記事で何ができるか

エクスプローラーから1つずつファイルを開いて検索する手間を省き、指定フォルダ内のExcelファイル群からキーワードを横断検索（コーパス風の検索）して結果を一覧シートに集約できます。

2. 想定環境・前提条件

• OS: Windows 10 / 11
• Excel: Microsoft 365 / Excel 2016以降
• 対象ファイル: 同一フォルダ（例: C:\サンプル）に格納された拡張子 .xlsx のファイル

3. 再構成VBAコード

以下は、記事の仕様を基に現在の環境向けに再構成したVBAコードです。マクロ有効ブック（.xlsm）の標準モジュールに貼り付けて実行してください。

Sub ExcelCorpusSearch()
    ' -----------------------------------------------------
    ' 再構成サンプルコード（前提条件）
    ' - 検索対象フォルダ: C:\サンプル\
    ' - 設定シート名: "リスト" (メイン設定および結果出力)
    ' - 検索キーワード: A1セル
    ' -----------------------------------------------------
    Dim wsList As Worksheet
    Dim targetFolder As String
    Dim fileName As String
    Dim keyword As String
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim outputRow As Long
    Dim foundCell As Range
    Dim firstAddress As String
    Dim leftContext As String
    Dim rightContext As String
    
    On Error GoTo ErrorHandler
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set wsList = ThisWorkbook.Sheets("リスト")
    targetFolder = "C:\サンプル\"
    keyword = wsList.Range("A1").Value
    
    If keyword = "" Then
        MsgBox "検索キーワードがA1セルに設定されていません。", vbExclamation
        Exit Sub
    End If
    
    ' 出力行の初期化（3行目から結果を出力する例）
    outputRow = 3
    wsList.Rows(outputRow & ": " & wsList.Rows.Count).ClearContents
    
    ' ヘッダーの設定
    wsList.Cells(outputRow - 1, 1).Value = "ファイル名"
    wsList.Cells(outputRow - 1, 2).Value = "シート名"
    wsList.Cells(outputRow - 1, 3).Value = "左周辺テキスト"
    wsList.Cells(outputRow - 1, 4).Value = "一致セル"
    wsList.Cells(outputRow - 1, 5).Value = "右周辺テキスト"
    
    fileName = Dir(targetFolder & "*.xlsx")
    
    Do While fileName <> ""
        Set wbTarget = Workbooks.Open(targetFolder & fileName, ReadOnly:=True)
        
        For Each wsTarget In wbTarget.Sheets
            Set foundCell = wsTarget.Cells.Find(What:=keyword, LookAt:=xlPart, LookIn:=xlValues)
            If Not foundCell Is Nothing Then
                firstAddress = foundCell.Address
                Do
                    ' 周辺セルの取得（左1セル、右1セル）
                    On Error Resume Next
                    leftContext = IIf(foundCell.Column > 1, foundCell.Offset(0, -1).Value, "")
                    rightContext = foundCell.Offset(0, 1).Value
                    On Error GoTo ErrorHandler
                    
                    outputRow = outputRow + 1
                    wsList.Cells(outputRow, 1).Value = fileName
                    wsList.Cells(outputRow, 2).Value = wsTarget.Name
                    wsList.Cells(outputRow, 3).Value = leftContext
                    wsList.Cells(outputRow, 4).Value = foundCell.Value
                    wsList.Cells(outputRow, 5).Value = rightContext
                    
                    Set foundCell = wsTarget.FindNext(foundCell)
                Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
            End If
        Next wsTarget
        
        wbTarget.Close False
        fileName = Dir()
    Loop
    
    MsgBox "串刺し検索が完了しました。", vbInformation
    
ErrorHandler:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If Err.Number <> 0 Then
        MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    End If
End Sub

4. 実行手順

1. Excelを開き、「リスト」という名前のシートを作成します。
2. 「リスト」シートの A1 セルに検索したいキーワードを入力します。
3. Cドライブ直下に「サンプル」フォルダを作成し、検索対象となるExcelファイルを配置します。
4. VBE（Visual Basic Editor）を開き、標準モジュールに上記のコードを貼り付けます。
5. ExcelCorpusSearch マクロを実行します。

5. 注意事項・セキュリティ

• 大量のファイルや巨大なワークブックを処理する場合、動作に時間がかかることがあります。
• マクロ実行中は画面描画や自動計算を一時停止しています。エラー発生時の復旧のため On Error 処理を設けていますが、実行前に必ず作業中のファイルのバックアップを取得してください。