多工作簿相同多工作表汇总

zyzdft · 发表于 2017-7-23 14:19

本人是个初学者,在网上找的代码拼凑出来的按背景色多工作簿汇总,目前想实现对汇总表中各工作表都进行多工作簿汇总，特发到网上求助!望老师及高手们给予解惑为谢!

同格式多工作簿多表汇总.zip (35.1 KB, 下载次数: 13)

凌空一羽 · 发表于 2017-7-23 15:50

有点意思

Sub lkyy()
Dim wb As Workbook
gtw = Application.GetOpenFilename(filefilter:="Excel(*xls文件),*.xls", MultiSelect:=True)
For a = 1 To Sheets.Count
tn = ThisWorkbook.Sheets(a).Name
Dim br(1 To 50, 1 To 3)
For j = 1 To 3
br(1, j) = Cells(1, j).Value
Next
For Each g In gtw
N = N + 1
Set wb = Workbooks.Open(g)
ar = wb.Sheets(tn).Range("a1").CurrentRegion
wb.Close 0
Set wb = Nothing
For i = 2 To UBound(ar)
For j = 1 To 3
br(i, j) = br(i, j) + ar(i, j)
Next j, i
Next
Sheets(a).Range("a1").Resize(50, 3) = br
For i = 2 To 50
For j = 1 To 3
If Sheets(a).Cells(i, j).Interior.ColorIndex = xlNone Then Sheets(a).Cells(i, j).ClearContents
Next j, i
Next a
End Sub

复制代码

zyzdft · 发表于 2017-7-24 09:30

凌空一羽发表于 2017-7-23 15:50
有点意思

非常感谢“凌空一羽”的热心帮助，已测试代码符合要求！，想另外请都一下，如果数据行不止50行或3列（数据行根据实际发生不一样），改为动态数组的话怎么修改？再次麻烦了，谢谢！

凌空一羽 · 发表于 2017-7-24 10:22

zyzdft 发表于 2017-7-24 09:30
非常感谢“凌空一羽”的热心帮助，已测试代码符合要求！，想另外请都一下，如果数据行不止50行或3列（数 ...

你可以设定br的列为1 to ? 这儿填大一个数，
然后遍历 j= 1 to ? 这儿填的跟上上面一样的数
即可了

zyzdft · 发表于 2017-7-24 14:43

老师，可以这样吗？
r = ActiveSheet.UsedRange.Rows.Count
c = ActiveSheet.UsedRange.Columns.Count
br(1 To r, 1 To c)
j=1 to c

zyzdft · 发表于 2017-7-24 14:52

本帖最后由 zyzdft 于 2017-7-24 16:52 编辑

凌空一羽发表于 2017-7-24 10:22
你可以设定br的列为1 to ? 这儿填大一个数，
然后遍历 j= 1 to ? 这儿填的跟上上面一样的数
即可了

已经想明白了，br为静态数组，不能使用变量r和c，正在试着改为动态数组来替换。

jjmysjg · 发表于 2017-7-24 16:39

同问，等待结果

		自动登录	找回密码
密码			免费注册

[求助] 多工作簿相同多工作表汇总