VBA效率测试

Question

我找到了一段VBA代码来测试线程How do you test running time of VBA code? 中代码的运行时。我实现了它，它起作用了。但是每次我运行一段简单的代码，如下所示，它会返回一个不同的结果。

我搜索和测试了许多代码，但没有找到我所期望的。

有没有一种方法可以测试代码并返回代码所需的时钟数？当我每次运行下面的代码时，会返回相同的值吗？

Sub teste_tempo()

    Dim eficiencia As New Ctimer
    eficiencia.StartCounter

    For i = 0 To 10
        i = i + 1
    Next i
    MsgBox eficiencia.TimeElapsed & "[ms]"

End Sub

Answer 1

首先，这段代码不是我设计的。我把它放在我的精美收藏品中。所有的功劳都必须归功于创建者。我在很多地方都找到了它。请尝试以下操作并比较结果：

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
            "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
            "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
            "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
            "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Public Function MicroTimer() As Double
    ' returns seconds from Windows API calls (high resolution timer)
    Dim cyTicks1 As Currency, cyTicks2 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0

    If cyFrequency = 0 Then getFrequency cyFrequency

    ' get ticks
    getTickCount cyTicks1
    getTickCount cyTicks2

    ' calc seconds
    If cyFrequency Then MicroTimer = cyTicks2 / cyFrequency
End Function

并以下面的方式使用它：

Sub teste_tempo()
 Dim i As Long, dTime As Double
    dTime = MicroTimer
    For i = 0 To 100000000
        i = i + 1
    Next i
    MsgBox (MicroTimer - dTime) * 1000 & " [ms]"
End Sub

但是，它再也不会返回与过去完全相同的时间了！窗口处理在不同时刻以不同的百分比加载您的CPU和RAM。差异将越来越小，与迭代次数成反比。