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

Question

在VBA中是否有代码可以包装一个函数,让我知道它运行的时间,以便我可以比较函数的不同运行时间？

Answer 1

除非你的功能很慢,否则你需要一个非常高分辨率的计时器.我所知道的最准确的是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

Answer 2

VBA中的定时器功能为您提供从午夜到1/100秒的经过秒数.

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

如果您需要更高的分辨率,我只需运行该功能1,000次并将总时间除以1,000.

Answer 3

如果您尝试像秒表一样返回时间,则可以使用以下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对于所需的任务来说太复杂了)

Answer 4

Sub Macro1()
    Dim StartTime As Double
    StartTime = Timer

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

输出：

运行时间：00:00:02

Answer 5

正如 Mike Woodhouse 所回答的那样，QueryPerformanceCounter 函数是测试 VBA 代码的最准确的方法（当您不想使用定制的 dll 时）。我编写了一个类（链接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

当然，如果只有一段代码，该表不是很有用，但是如果有多段代码，您会立即清楚代码中的瓶颈在哪里。该类包含一个 .Wait 函数，其功能与 Application.Wait 相同，但仅需要以秒为单位的输入，而不是时间值（需要大量字符来编码）。

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