[已解决]几个表汇总

c6770459

比较简单的一个表，前面是每个月的登记。汇总表里，扣款日期把每个月对应名字的扣款日期汇总在对应的框里，扣款金额就做一个合计，现金罚款也同理。 比如说陈飞，在1月和2月都有扣款，汇总行就显示这样。
最后再强调一点，月份会累积上去，请大神做好VBA后备注一下，以后月份增加上去后，怎么改才会把增加的月份累积上去

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-22 14:36

1. Sub 汇总()
   
2.     Dim sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     Set d2 = CreateObject("scripting.dictionary")
   
6.     For Each sh In Worksheets
   
7.         arr = sh.Range("c3:f" & sh.[c65536].End(3).Row)
   
8.         If sh.Name <> ActiveSheet.Name Then
   
9.             For i = 1 To UBound(arr)
   
10.                 x = arr(i, 1)
    
11.                 If arr(i, 2) <> "" Then d(x) = d(x) & Chr(10) & arr(i, 2)
    
12.                 If arr(i, 3) > 0 Then d1(x) = d1(x) + arr(i, 3)
    
13.                 If arr(i, 4) > 0 Then d2(x) = d2(x) + arr(i, 4)
    
14.             Next
    
15.         Else
    
16.             For i = 1 To UBound(arr)
    
17.                 x = arr(i, 1)
    
18.                 arr(i, 2) = Mid(d(x), 2)
    
19.                 arr(i, 3) = d1(x)
    
20.                 arr(i, 4) = d2(x)
    
21.             Next
    
22.             sh.Range("c3:f" & sh.[c65536].End(3).Row) = arr
    
23.         End If
    
24.     Next
    
25. End Sub
    

复制代码

跳转到最佳答案楼层

c6770459

在线等大神出现。。

珺珺妈

我只想说：一个非常简单的事情，被你搞的异常复杂。建议你看看小妖老师的改变旧习惯吧，先把你原始的表弄简单了，汇总就秒秒钟的事。。先去掉合并单元格，然后日期合法化

grf1973

1. Sub 汇总()
   
2.     Dim sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     Set d2 = CreateObject("scripting.dictionary")
   
6.     For Each sh In Worksheets
   
7.         arr = sh.Range("c3:f" & sh.[c65536].End(3).Row)
   
8.         If sh.Name <> ActiveSheet.Name Then
   
9.             For i = 1 To UBound(arr)
   
10.                 x = arr(i, 1)
    
11.                 If arr(i, 2) <> "" Then d(x) = d(x) & Chr(10) & arr(i, 2)
    
12.                 If arr(i, 3) > 0 Then d1(x) = d1(x) + arr(i, 3)
    
13.                 If arr(i, 4) > 0 Then d2(x) = d2(x) + arr(i, 4)
    
14.             Next
    
15.         Else
    
16.             For i = 1 To UBound(arr)
    
17.                 x = arr(i, 1)
    
18.                 arr(i, 2) = Mid(d(x), 2)
    
19.                 arr(i, 3) = d1(x)
    
20.                 arr(i, 4) = d2(x)
    
21.             Next
    
22.             sh.Range("c3:f" & sh.[c65536].End(3).Row) = arr
    
23.         End If
    
24.     Next
    
25. End Sub
    

复制代码

grf1973

请看附件。

c6770459

grf1973 发表于 2016-3-22 14:37
请看附件。

大神你好，假如我加上几个月的话，，还是会自动汇总的吗？

grf1973

会的，但是要保证汇总表是最后一张表

c6770459

grf1973 发表于 2016-3-22 20:32
会的，但是要保证汇总表是最后一张表

明白了，，谢谢！！！！