Тест эффективности VBA

Question

Я нашел код VBA для проверки времени выполнения кода в потоке Как вы проверяете время выполнения кода VBA? . Я реализовал, и это сработало. Но каждый раз, когда я запускаю простой код, как показано ниже, он возвращает мне другой результат.

Я искал и проверял много кодов, но не нашел то, что ожидал.

Есть ли способ проверить код и вернуть что-то вроде количества часов, которое требует код? Что-то, что каждый раз, когда я запускаю код, приведенный ниже, возвращает мне одно и то же значение?

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

Во-первых, я не разработал этот кусок кода. У меня есть это в моей коллекции хороших произведений. Весь кредит должен go человеку, который создал. Я нашел это во многих местах ... Попробуйте это и сравните результаты, пожалуйста:

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

Но, он никогда не вернется точно то же самое прошло время! Обработанное окно загружает ваш ЦП и ОЗУ в разных процентах для разных моментов. Различия будут все меньше и меньше обратно пропорционально числу итераций.