vba测试公式自动重算时长的代码

hhjjpp

1. Private Sub CommandButton1_Click()
   
2. Dim f$, i&, t#
   
3. f = [b1].Formula
   
4. Application.Calculation = xlManual
   
5. For i = 1 To 65536
   
6.     Cells(i, 2).Formula = f
   
7.     Cells(i, 3).Formula = f
   
8.     Cells(i, 4).Formula = f
   
9.     Cells(i, 5).Formula = f
   
10. Next
    
11. [f1] = 0
    
12. t = Timer
    
13. Calculate
    
14. t = Timer - t
    
15. MsgBox t & "秒"
    
16. [f1] = 100
    
17. Application.Calculation = xlAutomatic
    
18. End Sub
    

复制代码

      为了对比相同任务下公式的计算效率，设计了一段vba代码。
       为了防止测试时间为0，在26万个单元格输入相同公式来延长计算时间，便于实测。思路如下：
1.首先关闭自动重算，先输入公式（故意在公式中加f1，初始值100），然后把0赋值给f1——并不影响公式的实际运算结果
2.记录初始时间t
3.发出重算指令Calculate（由于处于手动重算状态，f1得到0之后，当时并没有重算关联的那26万个单元格）
4.记录当前时间，得自动重算时差
5.f1赋初始值100，程序退出前，重启自动重算

hhjjpp

实测结果如上，但是偶尔监测结果与上述数据有所出入，会出现0.078125秒、0.046875秒，而且不会一边倒，两种公式都可能出现上述时差。
从监测公式运行时间角度讲，上述代码有什么问题，有什么需要改进和完善的地方，请大家不吝赐教！
谢谢啦！

hhjjpp

ZhouFfett

电脑同时运行着很多进程。
打开Windows任务管理器，你会发现CPU使用率在不断地变化着。

这些都在影响着VBA返回的测算结果。
或许是不可能得到“精确”结果的，即使在同一台电脑上。
所以，不要追求太精确的结果，

hhjjpp

ZhouFfett 发表于 2016-8-21 19:07
电脑同时运行着很多进程。
打开Windows任务管理器，你会发现CPU使用率在不断地变化着。

3楼是在断网，退出qq、杀软等，以及其他尽可能退出的进程后的测试结果！
只是我没来及说而已！

hhjjpp

以及浏览器、任何在线运行软件、常驻内存的非系统软件（含附加安全进程）

ZhouFfett

太多因素在影响在系统时间。
操作系统有很多监控模块在确保自身的安全；
Excel运行过程，有时从磁盘上调用自己模块（有些模块是需要执行的时候才调用）；
磁盘不停地在旋转着，读写时间会有少少偏差；
电压电流的不稳定……

以上是我猜想的（纯属胡猜，不一定正确！），大概会造成电脑的0.0几秒的时间差。

大致上，半秒以内的时间差，大概人是感觉不出来的吧

hhjjpp

1. Private Sub CommandButton1_Click()
   
2. Dim f$, i&, t#
   
3. f = [b1].Formula
   
4. Application.Calculation = xlManual
   
5. [b2].Formula = f
   
6. [b2].Copy [b3:e65536]
   
7. [b2].Copy [c1:e2]
   
8. [f1] = 0
   
9. t = Timer
   
10. Calculate
    
11. t = Timer - t
    
12. MsgBox t & "秒"
    
13. [f1] = 100
    
14. Application.Calculation = xlAutomatic
    
15. End Sub
    

复制代码

发现vba的公式赋值代码运行时间要远超过复制粘贴代码！这样就有可能省出精力来进行大规模测试！

hhjjpp

1. Private Sub CommandButton1_Click()
   
2. Dim f$, i&, t#, d, data, arr
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set data = CreateObject("Scripting.Dictionary")
   
5. Application.Calculation = xlManual
   
6. For i = 7 To 8
   
7.     f = Cells(2, i).Formula
   
8.     Cells(i + 8, "g") = "'" & f
   
9.     [b1].Formula = f
   
10.     [b1].Copy [b2:e65536]
    
11.     [b1].Copy [c1:e1]
    
12.     Set d(i) = CreateObject("Scripting.Dictionary")
    
13.     For j = 1 To 1000                   '检测
    
14.         [f1] = 0
    
15.         t = Timer
    
16.         Calculate
    
17.         t = Timer - t
    
18.         d(i)(t) = d(i)(t) + 1
    
19.         If Not data.exists(t) Then
    
20.            data(t) = ""
    
21.         End If
    
22.         [f1] = 100
    
23.     Next
    
24. Next
    
25. arr = data.keys
    
26. n = data.Count
    
27. ReDim brr(1 To 2, 1 To n)
    
28. For j = 0 To n - 1                       '统计频次
    
29.     For i = 7 To 8
    
30.         brr(i - 6, j + 1) = d(i)(arr(j))
    
31.     Next
    
32. Next
    
33. [h14].Resize(1, n) = arr
    
34. [h15].Resize(2, n) = brr
    
35. Set d = Nothing
    
36. Set data = Nothing
    
37. Application.Calculation = xlAutomatic
    
38. End Sub

复制代码

自动检测并输出统计结果

hhjjpp

退出其他任何无关应用程序（包括所有打开的窗口、插件），并断网，能够强行退出的进程均全部退出，检测结果如下