[已解决]多表累加

心灵有约

多表累加.rar (16.71 KB, 下载次数: 8)

2016-2-19 09:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-2-19 09:38

1. Sub grf()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For k = 1 To 12
   
4.         With Sheets(k & "月")
   
5.             arr = .[a1].CurrentRegion
   
6.             For i = 2 To UBound(arr)
   
7.                 x = arr(i, 1)
   
8.                 d(x) = d(x) + arr(i, 5)
   
9.                 arr(i, 6) = d(x)
   
10.             Next
    
11.             .[f1].Resize(UBound(arr)) = Application.Index(arr, , 6)
    
12.         End With
    
13.     Next
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

心正意诚身修

閒著．．函數做了種．．

sry660

1. Sub 累计()
   
2.     Dim arr, i&, j&, x, d, k&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For k = 2 To 13
   
5.         With Sheets(k)
   
6.             arr = .[a1].CurrentRegion
   
7.             For i = 2 To UBound(arr)
   
8.                 x = arr(i, 2): d(x) = d(x) + arr(i, 5)
   
9.                 If d.exists(x) Then arr(i, 6) = d(x)
   
10.             Next
    
11.             .[a1].CurrentRegion = arr
    
12.         End With
    
13.     Next
    
14.     Set d = Nothing
    
15. End Sub

复制代码

grf1973

1. Sub grf()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For k = 1 To 12
   
4.         With Sheets(k & "月")
   
5.             arr = .[a1].CurrentRegion
   
6.             For i = 2 To UBound(arr)
   
7.                 x = arr(i, 1)
   
8.                 d(x) = d(x) + arr(i, 5)
   
9.                 arr(i, 6) = d(x)
   
10.             Next
    
11.             .[f1].Resize(UBound(arr)) = Application.Index(arr, , 6)
    
12.         End With
    
13.     Next
    
14. End Sub
    

复制代码