97

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

4

8 回答 8

87

除非您的功能非常慢，否则您将需要一个非常高分辨率的计时器。我知道的最准确的一个是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
于 2008-10-13T19:16:17.587 回答
52

VBA 中的 Timer 函数为您提供自午夜以来经过的秒数，精确到 1/100 秒。

Dim t as single
t = Timer
'code
MsgBox Timer - t
于 2008-10-13T23:51:56.890 回答
34

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

于 2011-07-25T17:32:28.140 回答
4

对于新手，这些链接解释了如何对您想要时间监控的所有潜艇进行自动分析：

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

于 2014-03-21T15:41:27.957 回答
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

于 2019-09-19T08:31:09.713 回答
2

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

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

于 2008-10-13T19:20:30.043 回答
0

正如 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
于 2021-07-16T09:26:56.830 回答
-1

带 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 个中最准确的运行时间。我也读过你如果它碰巧在穿过午夜时运行，可能会得到不正确的读数，这是一个罕见的例子，但仅供参考。

于 2020-04-14T23:41:46.787 回答