作者：绿色风
分类：
时间：2022-08-17
浏览：95
楼主
kevinchengcw |
Q: 如何利用vba代码实现跨工作簿Consolidate汇总数据？
A: 示例代码如下：
- Sub test()
- Dim Dic As Object, Dic2 As Object, Arr, N&, WB As Workbook, Ws As Worksheet, Rng As Range, FN$
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目,字典1用来存放各工作簿要汇总的数据区域,字典2用来存放打开的文件列表(因用consolidate汇总的工作簿要打开才能正常工作)
- Set Dic2 = CreateObject("scripting.dictionary")
- FN = Dir(ThisWorkbook.Path & "\*.xls?") '枚举当前目录下的excel工作簿
- Do While FN <> "" '当获取到的不为空值时继续循环
- If FN <> ThisWorkbook.Name Then '如果当前文件名不是当前工作簿的文件名,则
- Set WB = GetObject(ThisWorkbook.Path & "\" & FN) '通过getobject隐藏打开指定文件
- Dic2.Add FN, "" '把文件名添加到打开文件列表
- For Each Ws In WB.Worksheets '循环各个工作表
- If WorksheetFunction.CountA(Ws.UsedRange) > 0 Then '确定是否是有效的工作表
- With Ws
- Set Rng = .UsedRange.Find("W") '查找关键字所在位置
- If Not Rng Is Nothing Then '如果找到关键字位置,则根据关键字位置生成数据区位置的R1C1格式地址(含文件名及工作表名)作为key值存入字典1中
- Dic.Add "[" & WB.Name & "]" & Ws.Name & "!" & .Range(Rng.Offset(2), .Cells(.Cells(.Rows.Count, Rng.Column).End(3).Row, .Cells(Rng.Row, .Columns.Count).End(1).Column)).Address(ReferenceStyle:=xlR1C1), ""
- End If
- Set Rng = Nothing '防止再次使用变量时带入上次数据,使用结束后清空项目
- End With
- End If
- Next
- Set WB = Nothing '清空工作簿项目
- End If
- FN = Dir '循环到下一个文件
- Loop
- With [a3] '指定汇总表汇总数据区的第一个单元格位置
- Rows(.Row & ":" & Rows.Count).ClearContents '清空原有数据
- .Consolidate Sources:=Dic.keys, leftcolumn:=True, Function:=xlSum '所有找到的数据区域根据左侧数据标识进行汇总,并写入指定位置开始的汇总区域
- End With
- Arr = Dic2.keys '将字典2的key值赋值给数组
- For N = LBound(Arr) To UBound(Arr) '循环数组各项(即已打开的文件列表)
- Workbooks(Arr(N)).Close False '关闭循环到的文件
- Next N
- Set Dic = Nothing '清空字典项目
- Set Dic2 = Nothing
- End Sub
详见附件及素材源帖.
 lx.rar
|
2楼
xyf2210 |
下载收藏学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一