如何测试VBA代码的运行时间?

除非你的功能非常慢,否则你需要一个非常高分辨率的定时器。我知道最准确的是 QueryPerformanceCounter . 谷歌搜索更多信息。试着把下面的内容放到一个类中,调用它 CTimer .StartCounter 和 .TimeElapsed

Option Explicit

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double

Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#

Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
    Low = LI.lowpart
    If Low < 0 Then
        Low = Low + TWO_32
    End If
    LI2Double = LI.highpart * TWO_32 + Low
End Function

Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
    QueryPerformanceFrequency PerfFrequency
    m_crFrequency = LI2Double(PerfFrequency)
End Sub

Public Sub StartCounter()
    QueryPerformanceCounter m_CounterStart
End Sub

Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
    QueryPerformanceCounter m_CounterEnd
    crStart = LI2Double(m_CounterStart)
    crStop = LI2Double(m_CounterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property

VBA中的计时器功能提供从午夜起经过的秒数,为1/100秒。

Dim t as single
t = Timer
'code
MsgBox Timer - t

以下API返回自系统启动以来的时间(以毫秒为单位):

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub testTimer()
Dim t As Long
t = GetTickCount

For i = 1 To 1000000
a = a + 1
Next

MsgBox GetTickCount - t, , "Milliseconds"
End Sub

之后 http://www.pcreview.co.uk/forums/grab-time-milliseconds-included-vba-t994765.html (由于winmm.dll中的timeGetTime不适用于我,并且QueryPerformanceCounter对于所需的任务来说太复杂)

对于新手,这些链接解释了如何对要进行时间监控的所有Sub进行自动评测:

http://www.nullskull.com/a/1602/profiling-and-optimizing-vba.aspx

http://sites.mcpher.com/share/Home/excelquirks/optimizationlink 请参阅中的procProfiler.zip http://sites.mcpher.com/share/Home/excelquirks/downlable-items

Sub Macro1()
    Dim StartTime As Double
    StartTime = Timer

        ''''''''''''''''''''
            'Your Code'
        ''''''''''''''''''''
    MsgBox "RunTime : " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub

输出:

多年来,我们一直在winmm.dll中使用基于timeGetTime的解决方案,以获得毫秒精度。看见 http://www.aboutvb.de/kom/artikel/komstopwatch.htm

这篇文章是用德语写的,但是下载的代码(一个包装dll函数调用的VBA类)非常简单,可以在不阅读文章的情况下使用和理解。

https://github.com/jonadv/VBA-Benchmark

1. 仅初始化基准类
2. 在代码之间调用该方法。

Sub TimerBenchmark()

Dim bm As New cBenchmark

'Some code here
bm.TrackByName "Some code"

End Sub

这将自动将可读表打印到即时窗口:

IDnr  Name       Count  Sum of tics  Percentage  Time sum
0     Some code      1          163     100,00%     16 us
      TOTAL          1          163     100,00%     16 us

Total time recorded:             16 us

Sub TimerBenchmark()

Dim bm As New cBenchmark

bm.Wait 0.0001 'Simulation of some code
bm.TrackByName "Some code"

bm.Wait 0.04 'Simulation of some (time consuming) code here
bm.TrackByName "Bottleneck code"


bm.Wait 0.00004 'Simulation of some code, with the same tag as above
bm.TrackByName "Some code"

End Sub

打印带有百分比的表格,并汇总具有相同名称/标记的代码:

IDnr  Name             Count  Sum of tics  Percentage  Time sum
0     Some code            2       21.374       5,07%   2,14 ms
1     Bottleneck code      1      400.395      94,93%     40 ms
      TOTAL                3      421.769     100,00%     42 ms

Total time recorded:             42 ms

带2个小数位的秒数:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime) / 1000000, "#,##0.00") & " seconds") 'end timer

毫秒:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime), "#,##0.00") & " milliseconds") 'end timer

带逗号分隔符的毫秒数:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime) * 1000, "#,##0.00") & " milliseconds") 'end timer