仕様
ブックの内容を検索するツールを作成しました。
指定するディレクトリ内のブックの全シートを特定ワードで検索します。
シート1名を「設定」としC2検索対象ディレクトリを指定してください。
シート2名を「検索結果」としてください。
Sub SearchInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim searchRange As Range
Dim result As Range
Dim searchText As String
Dim summarySheet As Worksheet
Dim summaryRow As Long
' 検索対象のディレクトリを指定する
folderPath = ThisWorkbook.Sheets("設定").Range("C2").Value
'folderPath = "対象ディレクトリ"
' 検索対象のワードを指定する
' ユーザーに検索文字列を入力させる
searchText = InputBox("検索する文字列を入力してください", "検索")
' 検索文字列が入力されなかった場合は終了する
If searchText = "" Then
Exit Sub
End If
' 新しいシートを作成して、検索結果をまとめる
Set summarySheet = ThisWorkbook.Sheets("検索結果")
' 検索結果シートのデータを削除する
summarySheet.Rows("2:" & summarySheet.Rows.Count).ClearContents
' ヘッダーを設定する
summarySheet.Cells(1, 1).Value = "検索文字列: " & searchText
summarySheet.Cells(1, 1).Font.Bold = True
summarySheet.Cells(2, 1).Value = "ファイル名"
summarySheet.Cells(2, 2).Value = "シート名"
summarySheet.Cells(2, 3).Value = "セル"
summarySheet.Cells(2, 4).Value = "内容"
summaryRow = 3
' 指定されたディレクトリにあるすべてのファイルに対して検索を行う
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' ワークシートごとに検索を実行する
For Each ws In wb.Worksheets
Set searchRange = ws.UsedRange
Set result = searchRange.Find(searchText)
' 検索結果が見つかった場合は、メッセージを表示する
If Not result Is Nothing Then
summarySheet.Cells(summaryRow, 1).Value = wb.Name
summarySheet.Cells(summaryRow, 2).Value = ws.Name
summarySheet.Cells(summaryRow, 3).Value = result.Address
summarySheet.Cells(summaryRow, 4).Value = result.Value
summaryRow = summaryRow + 1
End If
Next
wb.Close False
fileName = Dir()
Loop
summarySheet.Columns.AutoFit
End Sub