Chronométrage en VBA

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 !

@+

Laisser un commentaire