| 
    
     |  | ▼MS−07B さん: こんばんは。
 作ってみました。
 
 マクロの書いてあるブックのシート1のA1に書かれた文字を検索し、
 B列にファイル名、C列にシート名を書き出します。
 
 ファイルを開いて、検索してますので、ファイル数やシート数が多いと
 時間がかかると思います。
 
 検索するフォルダや検索する文字の場所は適宜変えてください。
 もっと速い方法は、上級者の回答をお待ちください。
 
 Sub test2()
 
 Dim FSO As Object
 Dim FL As Object
 Dim SH As Worksheet
 Dim FR As Range
 
 Application.ScreenUpdating = False
 Set FSO = CreateObject("scripting.filesystemobject")
 With ThisWorkbook.Worksheets("Sheet1")
 .Range("B:C").ClearContents
 .Range("B1:C1").Value = Array("ファイル名", "シート名")
 If .Range("A1").Value <> "" Then
 For Each FL In FSO.getfolder("D:\文書\test\").Files
 If Right(FL, 3) = "xls" Then
 Workbooks.Open Filename:=FL
 For Each SH In Workbooks(FL.Name).Worksheets
 Set FR = SH.Cells.Find(What:=.Range("A1").Value, LookAt:=xlPart)
 If Not FR Is Nothing Then
 .Range("B65536").End(xlUp).Offset(1).Value = FL.Name
 .Range("C65536").End(xlUp).Offset(1).Value = SH.Name
 End If
 Next
 Workbooks(FL.Name).Close False
 End If
 Next
 Else
 MsgBox "検索する文字をA1に入力してください。"
 End If
 End With
 Set FSO = Nothing
 Application.ScreenUpdating = True
 
 End Sub
 
 
 |  |