[已解决]用VBA代替公式汇总

sd3000

由于因公式运算，且有循环引用，速度太慢，请帮忙解决。祝蛇年财源滚滚，阖家欢乐！ 汇总.rar (16.77 KB, 下载次数: 42)

2013-2-7 13:09 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

suye1010

2013-2-7 14:49

1. Sub 汇总()
   
2. Dim i%, arr, d
   
3. arr = Sheets("明细").Range("A4:I" & Sheets("明细").[A65536].End(3).Row)
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For i = 1 To 12
   
6. d(i) = Array(0, 0, 0, 0, "")
   
7. Next
   
8. For i = 1 To UBound(arr)
   
9. If Year(arr(i, 1)) = Sheets("汇总").Range("A3") Then
   
10. d(Month(arr(i, 1))) = Array(d(Month(arr(i, 1)))(0) + arr(i, 2), d(Month(arr(i, 1)))(1) + arr(i, 8), _
    
11. d(Month(arr(i, 1)))(2) + arr(i, 4), d(Month(arr(i, 1)))(3) + arr(i, 9), arr(i, 6))
    
12. End If
    
13. Next
    
14. For i = 1 To 12
    
15. Sheets("汇总").Range("A" & i + 3) = i & "月"
    
16. Sheets("汇总").Range("B" & i + 3).Resize(, 5) = d(i)
    
17. Next
    
18. Set d = Nothing
    
19. End Sub

复制代码

跳转到最佳答案楼层

csmctjg

字典套数组：
需要在VBE编辑器中引用字典。
工具>引用>浏览>找到文件名为  scrrun.dll

1. 
   
2. Sub 汇总()
   
3.     Dim i%, arr, d As New Dictionary
   
4.     arr = Sheets("明细").Range("A4:I" & Sheets("明细").[A65536].End(3).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         If Not d.Exists(Month(arr(i, 1))) Then d(Month(arr(i, 1))) = Array(0, 0, 0, 0, 0, #1/1/1900#)
   
7.         d(Month(arr(i, 1))) = Array(d(Month(arr(i, 1)))(0) + arr(i, 2), d(Month(arr(i, 1)))(1) + arr(i, 8), d(Month(arr(i, 1)))(2) + arr(i, 4), d(Month(arr(i, 1)))(3) + arr(i, 9), IIf(arr(i, 6) > d(Month(arr(i, 1)))(5), arr(i, 6), d(Month(arr(i, 1)))(4)), IIf(arr(i, 6) > d(Month(arr(i, 1)))(5), arr(i, 6), d(Month(arr(i, 1)))(5)))
   
8.     Next
   
9.     For i = 0 To d.Count - 1
   
10.         Sheets("汇总").Range("A" & i + 4) = d.Keys(i) & "月"
    
11.         Sheets("汇总").Range("B" & i + 4).Resize(, 5) = d.Items(i)
    
12.     Next
    
13. End Sub
    

复制代码

suye1010

1. Sub 汇总()
   
2. Dim i%, arr, d
   
3. arr = Sheets("明细").Range("A4:I" & Sheets("明细").[A65536].End(3).Row)
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For i = 1 To 12
   
6. d(i) = Array(0, 0, 0, 0, "")
   
7. Next
   
8. For i = 1 To UBound(arr)
   
9. If Year(arr(i, 1)) = Sheets("汇总").Range("A3") Then
   
10. d(Month(arr(i, 1))) = Array(d(Month(arr(i, 1)))(0) + arr(i, 2), d(Month(arr(i, 1)))(1) + arr(i, 8), _
    
11. d(Month(arr(i, 1)))(2) + arr(i, 4), d(Month(arr(i, 1)))(3) + arr(i, 9), arr(i, 6))
    
12. End If
    
13. Next
    
14. For i = 1 To 12
    
15. Sheets("汇总").Range("A" & i + 3) = i & "月"
    
16. Sheets("汇总").Range("B" & i + 3).Resize(, 5) = d(i)
    
17. Next
    
18. Set d = Nothing
    
19. End Sub

复制代码

sd3000

csmctjg 发表于 2013-2-7 14:17
字典套数组：
需要在VBE编辑器中引用字典。
工具>引用>浏览>找到文件名为  scrrun.dll

谢谢 csmctjg  ,如果不考虑按年汇总，你的方法是可以解决问题的。谢谢你的帮助，祝新年快乐！

sd3000

suye1010 发表于 2013-2-7 14:49

谢版主，非常好。祝你新年快乐！