|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub fso遍历汇总数据() '多工作簿同格式汇总
- Set d = CreateObject("scripting.dictionary")
- Set fso = CreateObject("scripting.filesystemobject")
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- For Each f In fso.getfolder(ThisWorkbook.Path).Files '遍历本工作簿文件夹内的所有文件
- If InStr(f.Name, "合并") = 0 Then '排除汇总表
- With Workbooks.Open(f)
- arr = .Sheets(1).UsedRange '分表装入数组
- .Close False '关闭分表
- End With
- For j = 2 To UBound(arr) '去除表头循环行
- d(arr(j, 1)) = d(arr(j, 1)) + Val(arr(j, 2)) '关键字存入字典,数量累加存入字典
- Next j
- End If
- Next f
- ActiveSheet.UsedRange.Offset(1).ClearContents '结果区清空
- [A1:B1].Value = Array("姓名", "数量合计")
- [A2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
- [B2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|