Excel|VBA不打开的情况下获取其它工作簿中的值，指定文件夹下工作簿名字模糊搜索定位|文件夹

Sub 提数_芐雨()

    Dim MyPath As String, Temp As String

    Dim arr, brr

    Dim wb As Workbook, twb As Workbook

    Dim sht As Worksheet, sh As Worksheet

    On Error Resume Next  '防错，打开无目标的工作表

    arr = Range("A2:C" & Cells(Rows.Count, 1).End(3).Row)

    MyPath = ThisWorkbook.Path & "\Aktuell"  '当前文件夹的路径

    ReDim brr(1 To UBound(arr), 1 To 1)

    For i = 1 To UBound(arr)

        fs = Dir(MyPath & "\*.xls") '查找文件名

        Do While fs <> ""

            If InStr(1, fs, arr(i, 1)) > 0 Then   '与文件名相符时执行

                Set wb = GetObject(MyPath & "\" & fs)   '打开文件

                Lrow = wb.Sheets(arr(i, 2)).Cells(Rows.Count, 1).End(3).Row '最大行号

                With wb.Sheets(arr(i, 2)).Range("a1:a" & Lrow)

                    Set C = .Find(arr(i, 3), LookIn:=xlValues) '查找第一列的内容

                    If Not C Is Nothing Then   '非空时执行

                        brr(i, 1) = C.Offset(0, 4) '右偏移第四个单元格

                    End If

                End With

                wb.Close

            End If

            fs = Dir

        Loop

    Next

    Range("D2").Resize(UBound(arr), 1) = brr

    MsgBox "完成"

End Sub