你如何测试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

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

对于newbees，这些链接解释了如何自动分析您想要监视的所有潜艇：

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

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

中的procProfiler.zip

Answer 5

多年来，我们在winmm.dll中使用了基于timeGetTime的解决方案，精确到毫秒级。见http://www.aboutvb.de/kom/artikel/komstopwatch.htm

这篇文章是德文的，但是下载中的代码（包装dll函数调用的VBA类）非常简单，无法阅读文章即可使用和理解。

Answer 6

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 7

正如 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

Answer 8

秒数带有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

将它留给所有正在寻找像我一样使用秒到2小数位格式的简单计时器的人来说。这些是我喜欢使用的简短而可爱的小计时器。它们在子或函数的开头仅占用一行代码，而在结尾处仅占用一行代码。这些并不意味着疯狂准确，我个人通常并不关心少于1/100秒的内容，但是毫秒计时器将为您提供这3种中最准确的运行时间。我也读过您如果它恰好在午夜时分运行，则可以获取不正确的读数，这种情况很少见，但仅供参考。