0
0

More than 1 year has passed since last update.

VBAでブック検索ツール

Last updated at Posted at 2023-06-15

仕様

ブックの内容を検索するツールを作成しました。
指定するディレクトリ内のブックの全シートを特定ワードで検索します。
シート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
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0