|
Sub xx()
pth = ThisWorkbook.Path
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(pth)
For Each f In ff.Files
Do While f <> ""
Rem 具体提取哪类文件,还是需要根据文件扩展名进行处理
If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then
If f.Name <> ThisWorkbook.Name And f.Name <> "~&新建 Microsoft Excel 工作表.xlsm" Then
Set wb = Workbooks.Open(f)
For Each sht In wb.Sheets
If WorksheetFunction.CountA(sht.UsedRange) > 1 Then
arr = wb.Worksheets("BOM").Range("A6:K6548")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
n = 0
For i = 1 To UBound(arr)
If arr(i, 4) = "贴片功率电感" Or arr(i, 4) = "贴片磁芯电感" Then
n = n + 1
For s = 3 To 5
brr(n, s) = arr(i, s) 'dic(Arr(i,4))=Range(i,3).Resize(0,2)
Next s
End If
Next i
End If
Next sht
sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(n, UBound(brr, 2)) = brr
wb.Close False
End If
End If
Loop
Next f
End Sub
---------------------------------代码运行到【Set wb = Workbooks.Open(f)】时报错“1004” 详情见图,望老师指点
|
|