[已解决]求助老师给予代码优化

xuesheng1

求助老师给予优化：

    数组从20起循环到结尾，分别计算

1，i=20行，h5等于trr从20行起向上前5个的累加
2，i=20行，h10等于trr从20行起向上前10个的累加
3，i=20行，h20等于trr从20行起向上前20个的累加

    我现在这个循环累加过程运算速度很慢（我有很多表很多列），求助各位老师们帮助给予优化，万分感谢！


求老师帮助.rar (10.77 KB, 下载次数: 3)

2015-6-1 12:42 上传

点击文件名下载附件


Private Sub CommandButton1_Click()

Dim trr
Dim t&, i&, w5&, w10&, w20&
Dim h5&, h10&, h20&


t = Timer

Application.ScreenUpdating = False    '关闭屏幕刷新
Application.DisplayAlerts = False      '禁止弹出警告对话框


trr = [a1].CurrentRegion


    For i = 20 To UBound(trr)

    h5 = 0: h10 = 0: h20 = 0


            For w5 = i - 4 To i

            h5 = h5 + trr(w5, 1)

            Next


            For w10 = i - 9 To i

            h10 = h10 + trr(w10, 1)

            Next


            For w20 = i - 19 To i

            h20 = h20 + trr(w20, 1)

            Next


    '输出结果


    Next

Debug.Print Timer - t

End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2015-6-1 20:16

两法供比较，新方法速度快一些。数据量大时更明显。

1. Sub 原方法()
   
2.     Dim trr
   
3.     Dim i&, w&
   
4.     Dim h5&, h10&, h20&
   
5.     t = Timer
   
6.     Application.ScreenUpdating = False    '关闭屏幕刷新
   
7.     Application.DisplayAlerts = False      '禁止弹出警告对话框
   
8.     trr = [a1].CurrentRegion
   
9.     ReDim brr(1 To UBound(trr), 1 To 3) As Long
   
10.     For i = 20 To UBound(trr)
    
11.         n = n + 1
    
12.         For w = i - 19 To i
    
13.             x = trr(w, 1)
    
14.             brr(n, 3) = brr(n, 3) + x
    
15.             If w >= i - 9 Then brr(n, 2) = brr(n, 2) + x
    
16.             If w >= i - 4 Then brr(n, 1) = brr(n, 1) + x
    
17.         Next
    
18.     '输出结果
    
19.     Next
    
20.     [c5].Resize(n, 3) = brr
    
21.     MsgBox Timer - t
    
22. End Sub
    
23. 
    
24. Sub 新方法()
    
25.     Dim trr
    
26.     Dim i&, w&
    
27.     t = Timer
    
28.     Application.ScreenUpdating = False    '关闭屏幕刷新
    
29.     Application.DisplayAlerts = False      '禁止弹出警告对话框
    
30.     trr = [a1].CurrentRegion
    
31.     ReDim brr(1 To UBound(trr), 1 To 3) As Long
    
32.     i = 20: n = 1
    
33.     For w = 1 To i
    
34.         x = trr(w, 1)
    
35.         brr(n, 3) = brr(n, 3) + x
    
36.         If w >= i - 9 Then brr(n, 2) = brr(n, 2) + x
    
37.         If w >= i - 4 Then brr(n, 1) = brr(n, 1) + x
    
38.     Next
    
39.    
    
40.     For i = 21 To UBound(trr)
    
41.         n = n + 1
    
42.         x = trr(i, 1)
    
43.         brr(n, 3) = brr(n - 1, 3) + x - trr(i - 20, 1)
    
44.         brr(n, 2) = brr(n - 1, 2) + x - trr(i - 10, 1)
    
45.         brr(n, 1) = brr(n - 1, 1) + x - trr(i - 5, 1)
    
46.     Next
    
47.     [g5].Resize(n, 3) = brr
    
48.     MsgBox Timer - t
    
49. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

没什么好的办法，代码简化一点，速度提高有限。

1. Private Sub tt()
   
2.     Dim trr
   
3.     Dim i&, w&
   
4.     Dim h5&, h10&, h20&
   
5.     t = Timer
   
6.     Application.ScreenUpdating = False    '关闭屏幕刷新
   
7.     Application.DisplayAlerts = False      '禁止弹出警告对话框
   
8.     trr = [a1].CurrentRegion
   
9.     For i = 20 To UBound(trr)
   
10.         h5 = 0: h10 = 0: h20 = 0
    
11.         For w = i - 19 To i
    
12.             x = trr(w, 1)
    
13.             h20 = h20 + x
    
14.             If w >= i - 9 Then h10 = h10 + x
    
15.             If w >= i - 4 Then h5 = h5 + x
    
16.         Next
    
17.     '输出结果
    
18.     Next
    
19.     Debug.Print Timer - t
    
20. End Sub

复制代码

xuesheng1

grf1973 发表于 2015-6-1 14:17
没什么好的办法，代码简化一点，速度提高有限。

嗯 ，谢谢您，的确速度没有明显提升，还请您或各位老师们，百忙之中帮忙看看，能否有最好方法，谢谢！

grf1973

两法供比较，新方法速度快一些。数据量大时更明显。

1. Sub 原方法()
   
2.     Dim trr
   
3.     Dim i&, w&
   
4.     Dim h5&, h10&, h20&
   
5.     t = Timer
   
6.     Application.ScreenUpdating = False    '关闭屏幕刷新
   
7.     Application.DisplayAlerts = False      '禁止弹出警告对话框
   
8.     trr = [a1].CurrentRegion
   
9.     ReDim brr(1 To UBound(trr), 1 To 3) As Long
   
10.     For i = 20 To UBound(trr)
    
11.         n = n + 1
    
12.         For w = i - 19 To i
    
13.             x = trr(w, 1)
    
14.             brr(n, 3) = brr(n, 3) + x
    
15.             If w >= i - 9 Then brr(n, 2) = brr(n, 2) + x
    
16.             If w >= i - 4 Then brr(n, 1) = brr(n, 1) + x
    
17.         Next
    
18.     '输出结果
    
19.     Next
    
20.     [c5].Resize(n, 3) = brr
    
21.     MsgBox Timer - t
    
22. End Sub
    
23. 
    
24. Sub 新方法()
    
25.     Dim trr
    
26.     Dim i&, w&
    
27.     t = Timer
    
28.     Application.ScreenUpdating = False    '关闭屏幕刷新
    
29.     Application.DisplayAlerts = False      '禁止弹出警告对话框
    
30.     trr = [a1].CurrentRegion
    
31.     ReDim brr(1 To UBound(trr), 1 To 3) As Long
    
32.     i = 20: n = 1
    
33.     For w = 1 To i
    
34.         x = trr(w, 1)
    
35.         brr(n, 3) = brr(n, 3) + x
    
36.         If w >= i - 9 Then brr(n, 2) = brr(n, 2) + x
    
37.         If w >= i - 4 Then brr(n, 1) = brr(n, 1) + x
    
38.     Next
    
39.    
    
40.     For i = 21 To UBound(trr)
    
41.         n = n + 1
    
42.         x = trr(i, 1)
    
43.         brr(n, 3) = brr(n - 1, 3) + x - trr(i - 20, 1)
    
44.         brr(n, 2) = brr(n - 1, 2) + x - trr(i - 10, 1)
    
45.         brr(n, 1) = brr(n - 1, 1) + x - trr(i - 5, 1)
    
46.     Next
    
47.     [g5].Resize(n, 3) = brr
    
48.     MsgBox Timer - t
    
49. End Sub
    

复制代码

xuesheng1

grf1973 发表于 2015-6-1 20:16
两法供比较，新方法速度快一些。数据量大时更明显。

grf1973 老师您好：

    您的新方法太棒了，节省运算时间整整4倍，谢谢您的帮助

          祝您心想事成！万事顺意！！！