更新时间:2023-02-13 17:42:51
您绝对不需要所有这些代码.
You definitely don't need all that code.
尝试一下-如果将查找"部分拆分为单独的方法,则管理起来会更容易.
Try this out - it's easier to manage if you split out the "find" part into a separate method.
Option Explicit
Sub ImportDataFromMultipleFiles()
Dim filenames As Variant, wb As Workbook
Dim rngDest As Range, colFound As Collection, f, i As Long
Set rngDest = ActiveSheet.Range("A2") '<< results start here
filenames = Application.GetOpenFilename( _
FileFilter:="Excel Filter(*xlsx), *.xlsx", MultiSelect:=True)
If TypeName(filenames) = "Boolean" Then Exit Sub '<< nothing selected
Application.FindFormat.Clear
For i = 1 To UBound(filenames) 'counter for files
Set wb = Workbooks.Open(filenames(i))
Set colFound = FindAll(wb.Sheets(1).UsedRange, "Test*Results:") '<< get matches
Debug.Print "Found " & colFound.Count & " matches in " & wb.Name '<<EDIT
For Each f In colFound
f.Copy rngDest
Set rngDest = rngDest.Offset(1, 0)
Debug.Print "", f.Value
Next f
wb.Close False
Next i
End Sub
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range
Dim addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function