Chronométrage en VBA

philben — Fri, 20 Apr 2012 22:37:57 +0000

Vous souhaitez comparer le temps d’éxecution de différentes implémentations d’une fonction ou d’un code ?
Des solutions sont présentées…

Les solutions
Habituellement, j’utilise la fonction standard Timer() pour déterminer le temps écoulé entre le début et la fin d’un code. Sa résolution est de 10ms ce qui est suffisant dans la plupart des cas si le temps écoulé est >= 1 seconde. Dans le cas contraire, on peut lancer x fois le même code pour réduire la part de l’erreur.
Noter que si l’heure système est modifiée, Timer() suit aussi cette modification !

Une deuxième solution consiste à utiliser l’API GetTickCount() qui retourne le nombre de millisecondes écoulées depuis le démarrage de Windows. Théoriquement, Au bout de ~49,71 jours le compteur revient à zéro (2^32 ms soit un entier long non signé) mais avec VBA, l’API retourne un entier long signé et le compteur devient négatif après ~24,85 jours. Sa résolution est de l’ordre de 15ms.

Une troisième solution consiste à utiliser l’API timeGetTime() qui retourne aussi le nombre de millisecondes écoulées depuis le démarrage de Windows tout comme GetTickCount() mais sa résolution est de l’ordre de la milliseconde.

Enfin, l’API de référence est QueryPerformanceCounter(). Sa résolution dépend du système mais elle est de l’ordre de la microseconde.

Une classe VBA de chronométrage
je souhaitai écrire une classe qui implémente QueryPerformanceCounter() mais le travail avait déjà été fait depuis l’an 2000 par C. Eswar Santhosh. Vous trouverez ici le code.

Calcul des résolutions
En m’appuyant sur cette classe, j’ai écrit une fonction qui permet d’estimer la résolution des différentes solutions présentées :

Option Compare Database
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Function testtime()
Const cNbTest As Long = 100, cNbFunc As Long = 3
Const cMin As Long = 1, cSum As Long = 2, cBcle As Long = 3, cMax As Long = 4
Dim oT As cTimer
Dim aRes(0 To cNbFunc, cMin To cMax) As Double
Dim TimerT0 As Single, TickT0 As Long, TimeT0 As Long
Dim i As Long, j As Long, k As Long

Set oT = New cTimer
For i = 0 To cNbFunc
aRes(i, cMin) = 999
Next i

With oT
Debug.Print "-> High timer activé ?", .IsHiTimer
Debug.Print "-> Nombre de tests : ", cNbTest

For i = 0 To cNbFunc
k = 0
For j = 1 To cNbTest
Select Case i
Case 0
.StartTimer
k = i
Do
k = k + 1
Loop Until k > i
.EndTimer
Case 1
.StartTimer
TimerT0 = Timer
Do
k = k + 1
Loop Until Timer > TimerT0
.EndTimer
Case 2
.StartTimer
TickT0 = GetTickCount
Do
k = k + 1
Loop Until GetTickCount > TickT0
.EndTimer
Case 3
.StartTimer
TimeT0 = timeGetTime
Do
k = k + 1
Loop Until timeGetTime > TimeT0
.EndTimer
End Select
aRes(i, cSum) = aRes(i, cSum) + .Elapsed
If .Elapsed < aRes(i, cMin) Then aRes(i, cMin) = .Elapsed
If .Elapsed > aRes(i, cMax) Then aRes(i, cMax) = .Elapsed
DoEvents

Next j

aRes(i, cBcle) = k
Debug.Print "Boucle n°" & i, "Min (ms):" & Round(aRes(i, cMin), 3), _
"Max (ms):" & Round(aRes(i, cMax), 3), "Somme (ms):" & Round(aRes(i, cSum), 3), "Nb Boucles:" & k
DoEvents
Next i
End With

Debug.Print "-> Résolutions (en millisecondes) rectifiées du placebo :" & vbNewLine & _
"Timer() : " & Round((aRes(1, cSum) - aRes(0, cSum)) / cNbTest), _
"Temps moyen d'une boucle (µs): " & Round(aRes(1, cSum) / aRes(1, cBcle) * 1000, 5) & vbNewLine & _
"GetTickCount() : " & Round((aRes(2, cSum) - aRes(0, cSum)) / cNbTest), _
"Temps moyen d'une boucle (µs): " & Round(aRes(2, cSum) / aRes(2, cBcle) * 1000, 5) & vbNewLine & _
"TimeGetTime() : " & Round((aRes(3, cSum) - aRes(0, cSum)) / cNbTest), _
"Temps moyen d'une boucle (µs): " & Round(aRes(3, cSum) / aRes(3, cBcle) * 1000, 5)
Debug.Print "Résultat de Timer() à prendre avec des pincettes car résolution théorique de 10ms..."

Set oT = Nothing
End Function

Bon chronométrage !

Philben - Ms Access » Time

Chronométrage en VBA