Sub 提數(shù)_芐雨()
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" '當(dāng)前文件夾的路徑
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 '與文件名相符時執(zhí)行
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) '查找第一列的內(nèi)容
If Not C Is Nothing Then '非空時執(zhí)行
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
本站僅提供存儲服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請
點擊舉報。
