Question

使用VBA求和：同一文件夹下所有工作簿每个工作表数据区域累加到汇总工作簿中相对应的每个工作表。

举例说明：现在一个文件夹下有5个工作簿，每个工作簿的工作表的数量、格式、都完全一模一样，只有数据不一样。现在我要生成一张5个工作簿每个工作表累加后的汇总工作簿。图示1、2：支行1工作簿共有17个工作表，而第17张工作表每月有所增加。支行2、3、4、5,的格式都是这样的，希望生成的汇总工作簿的所有格式也是一样的，但是数据区域是对应的累加项。我已经会使用数组遍历每个工作簿的每一张表求和，下列代码就是将所有工作簿的工作表1累加的方案。我用的是个笨办法，将这各代码复制了17遍，才将17张表的数据累加成功。但是因此带来的问题是：1、代码计算量较大，会引起电脑短暂卡机；2、因为第17张科目过段时间有所改变，并且以后还可能增加到18张，所以每次变动就得手工改代码，很麻烦。求助大侠：解决上述两个麻烦。能不能使用循环语句，或者其他更高效简洁的代码方案解决累加方案。高分求有效解决方案！ Dim MyPath$, MyName$, arr, brr, i&, j&, m& Application.ScreenUpdating = False MyPath = ThisWorkbook.Path & "\" MyName = Dir(MyPath & "*.xls") Sheets(1).Range("d4:i54").ClearContents Do While MyName <> "" If MyName <> ThisWorkbook.Name Then m = m + 1 With GetObject(MyPath & MyName) If m = 1 Then brr = .Sheets(1).Range("d4:i54") Else arr = .Sheets(1).Range("d4:i54") For i = 1 To 51 For j = 1 To 6 If Len(arr(i, j)) Then brr(i, j) = brr(i, j) + arr(i, j) Next Next End If .Close False End With End If MyName = Dir Loop Sheets(1).Range("d4:i54") = brr Application.ScreenUpdating = True





Answer 1

80元 给你写个 ，
你要是想自己做 ，简单给你个方向： 字典+ 数组

追问

一是不谈金钱；
二是我目前用我这个代码也能在一分钟内完成目标工作
三是我就对字典不怎么了解，所以求助百度知道。
四还是感谢！