[已解决]求同个工作簿多个表格数据汇总问题，，

下雨dê天

不废话 直接上图  实际表格数据不止这些，，，

最佳答案

月排行榜 / 总排行榜

grf1973

2015-9-1 15:33

1. Sub tt()
   
2.     Dim Sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     rq = Val(ActiveSheet.Name)     '当前表格日期
   
5.     crr = Array(24, 25, 29, 34, 35)
   
6.     For Each Sh In Worksheets
   
7.         arr = Sh.Range("a1:an" & Sh.[a65536].End(3).Row)
   
8.         If Val(Sh.Name) > 0 And Val(Sh.Name) < rq Then        '所有日期小于当前表格日期的工作表
   
9.             For i = 6 To UBound(arr)
   
10.                 If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
    
11.                 If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    
12.                 For j = 0 To UBound(crr)
    
13.                     c = crr(j)
    
14.                     x = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(4, c)   '款号+款式+日期+统计项为key
    
15.                     d(x) = d(x) + arr(i, c)   '累加为item
    
16.                 Next
    
17.             Next
    
18.         ElseIf Sh.Name = ActiveSheet.Name Then    '当前表
    
19.             For i = 6 To UBound(arr)
    
20.                 If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
    
21.                 If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    
22.                 For j = 0 To UBound(crr)
    
23.                     c = crr(j)
    
24.                     x = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(4, c)   '款号+款式+日期+统计项为key
    
25.                     arr(i, c) = d(x)        '累加为item
    
26.                 Next
    
27.             Next
    
28.             For j = 0 To UBound(crr)
    
29.                 c = crr(j)
    
30.                 Sh.Cells(1, c).Resize(UBound(arr), 1) = Application.Index(arr, , c)      '对应列填入结果
    
31.             Next
    
32.         End If
    
33.     Next
    
34. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Dim Sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     rq = Val(ActiveSheet.Name)     '当前表格日期
   
5.     crr = Array(24, 25, 29, 34, 35)
   
6.     For Each Sh In Worksheets
   
7.         arr = Sh.Range("a1:an" & Sh.[a65536].End(3).Row)
   
8.         If Val(Sh.Name) > 0 And Val(Sh.Name) < rq Then        '所有日期小于当前表格日期的工作表
   
9.             For i = 6 To UBound(arr)
   
10.                 If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
    
11.                 If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    
12.                 For j = 0 To UBound(crr)
    
13.                     c = crr(j)
    
14.                     x = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(4, c)   '款号+款式+日期+统计项为key
    
15.                     d(x) = d(x) + arr(i, c)   '累加为item
    
16.                 Next
    
17.             Next
    
18.         ElseIf Sh.Name = ActiveSheet.Name Then    '当前表
    
19.             For i = 6 To UBound(arr)
    
20.                 If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
    
21.                 If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    
22.                 For j = 0 To UBound(crr)
    
23.                     c = crr(j)
    
24.                     x = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(4, c)   '款号+款式+日期+统计项为key
    
25.                     arr(i, c) = d(x)        '累加为item
    
26.                 Next
    
27.             Next
    
28.             For j = 0 To UBound(crr)
    
29.                 c = crr(j)
    
30.                 Sh.Cells(1, c).Resize(UBound(arr), 1) = Application.Index(arr, , c)      '对应列填入结果
    
31.             Next
    
32.         End If
    
33.     Next
    
34. End Sub

复制代码

grf1973

你的要求是对应列累加所有之前表格对应列。感觉这样结果有问题。应该是前一张表格对应数加上本表产量数才对。

下雨dê天

你好  我试了一下 得出来的结果 全部 为空。。。