Excelで検索結果リストを生成！部分一致でブック全体を検索するVBAマクロ

ブック全体から特定のキーワードに部分一致するセルを検索し、その結果を一覧表示するVBAマクロの作り方をご紹介します。

このマクロが実現すること
コードの登録方法
1. コード
実行手順と結果
1. 手順
2. 結果の確認
使用時の注意点

このマクロが実現すること

このVBAマクロは、入力されたキーワードに基づいてExcelブック内の全シートを検索します。検索結果は、新しく生成されたシートに「セルの位置」「セルの値」「対象セルへのハイパーリンク」と共に一覧表示されます。これにより、大量のデータの中から必要な情報を迅速に見つけ出すことができます。

コードの登録方法

このマクロを使うためには、まずExcelのVBAエディタで新しいモジュールを作成し、提供されたコードを貼り付ける必要があります。以下の手順で行ってください：

ExcelでVBAエディタを開きます（Alt + F11）。
「挿入」メニューから「標準モジュール」を選択します。
提供されたコードを新しいモジュールに貼り付けます。

コード

Sub SearchWorkbook()
    Dim ws As Worksheet
    Dim resultSheet As Worksheet
    Dim searchKeyword As String
    Dim lastRow As Long, r As Long
    Dim cell As Range
    Dim resultSheetName As String
    Dim timestamp As String

    ' キーワードの入力
    searchKeyword = InputBox("検索するキーワードを入力してください。")

    If searchKeyword = "" Then Exit Sub

    ' タイムスタンプの生成
    timestamp = Format(Now, "yyyymmddhhmmss")

    ' 結果シートの作成
    Set resultSheet = Sheets.Add(After:=ActiveSheet)
    resultSheetName = searchKeyword & "_" & timestamp & "_result"
    resultSheet.Name = resultSheetName

    ' ヘッダーの追加
    resultSheet.Cells(1, 1).Value = "位置"
    resultSheet.Cells(1, 2).Value = "値"
    resultSheet.Cells(1, 3).Value = "移動"

    r = 2

    ' ブック内のすべてのシートをループ
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name Like "*_result" Then
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

            ' シート内のすべてのセルをループ
            For Each cell In ws.Range("A1:Z" & lastRow) ' A1からZ列まで検索
                If InStr(cell.Value, searchKeyword) > 0 Then
                    ' 結果の追加
                    resultSheet.Cells(r, 1).Value = ws.Name & "!" & cell.Address
                    resultSheet.Cells(r, 2).Value = cell.Value
                    resultSheet.Hyperlinks.Add Anchor:=resultSheet.Cells(r, 3), Address:="", _
                        SubAddress:=ws.Name & "!" & cell.Address, TextToDisplay:="移動"
                    r = r + 1
                End If
            Next cell
        End If
    Next ws

    ' 列の幅を自動調整
    resultSheet.Columns("A:C").AutoFit

    ' 結果シートにフォーカス
    resultSheet.Activate
End Sub