vba读取excel遍历文件指定数据
发布网友
发布时间：2022-04-25 05:30
共1个回答
热心网友
时间：2022-05-29 22:26
Excel文件格式一致，汇总求和，其他需求自行变通容
汇总使用了字典
Public d
Sub 按钮1_Click()
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
Cells(1, 1) = "编号"
Cells(1, 2) = "数量"
Set d = CreateObject("scripting.dictionary")
Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
Application.ScreenUpdating = True
If d.Count > 0 Then
ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End If
End Sub
Sub Getfd(ByVal pth)
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(pth)
For Each f In ff.Files
Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理
If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then
If f.Name <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(f)
For Each sht In wb.Sheets
If WorksheetFunction.CountA(sht.UsedRange) > 1 Then
arr = sht.UsedRange
For j = 2 To UBound(arr)
d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)
Next j
End If
Next sht
wb.Close False
End If
End If
Next f
For Each fd In ff.subfolders
Getfd (fd)
Next fd
End Sub
