Calcul temps execution code

vgendron

XLDnaute Barbatruc
Bonjour le forum !!

Certain(e) s d'entre vous sont tellement bons que vous allez jusqu'à mesurer des temps d'execution, ce qui vous permet de nous proposer différents codes associés à leur temps d'execution.. et c'est top !
ex: code1 -->10s
code2-->1.27s

il apparait ainsi évident que l'utilisation de tableaux ou de dictionnaires est souvent bien plus rapide que faire des boucles interminables..

THE question:
comment mesurez vous ces temps d'execution?
s'agit il d'une fonction VBA? ou d'un bout de code que vous inserez? (je ne vous imagine pas vraiment avec votre chrono à la main :) encore que :-D
 

Dranreb

XLDnaute Barbatruc
Bonjour
Il s'agit d'API :
VB:
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private TopDépart As Currency, TopFin As Currency, DTop1sec As Currency
…
…
…
Rem — Départ action
QueryPerformanceCounter TopDépart
…
…
…
Rem — Fin action
QueryPerformanceCounter TopFin
QueryPerformanceFrequency DTop1sec
msgbox "Ça a duré " & (TopFin - TopDépart) / DTop1sec & " secondes"
 
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Bonjour à toutes et à tous,

Ou bien :
Code:
Option Explicit
Sub Durée_calculer()
    Dim c As Range, durée
    durée = Timer
'    For Each c In Selection
'        c = 2 * 2
'    Next
    MsgBox "Durée : " & Format(Timer - durée, " 0.0000")
End Sub
A bientôt :)
 

Dranreb

XLDnaute Barbatruc
Bonjour DoubleZéro,
Oui, si on ne souhaite qu'un résultat beaucoup moins précis, à 15,625 millisecondes près.
(Parfois un peu plus, parfois un peu moins, enfin c'est le délai typique entre deux révisions périodiques de la valeur donnée par VBA.Timer.)
QueryPerformanceCounter donne des résultats plus précis qu'à la microseconde près.
 
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Re-bonjour,
... QueryPerformanceCounter donne des résultats plus précis qu'à la microseconde près.
Selon la durée d'exécution, je ne parviens pas à obtenir une valeur "parlante" :

upload_2017-6-12_18-32-58.png


A bientôt :)
 

Dranreb

XLDnaute Barbatruc
VB:
Sub t()
Dim F As Currency, C1 As Currency, C2 As Currency
QueryPerformanceFrequency F
QueryPerformanceCounter C1
QueryPerformanceCounter C2
MsgBox Format(1000000000 * (C2 - C1) / F, "000") & " nanosecondes"
End Sub
Remarque: rarement, cette manœuvre peut donner 0.

Dans un UserForm montrant l'activité d'un traitement pouvant durer aussi bien quelques µs que quelques jours (on l’interrompt quand ça commence à se présenter comme ça), j'ai cette méthode appelée par le processus lorsque ça se termine bien :
VB:
Public Sub Conclure()
Dim T As Double, S() As String, M As Double, E As Long
QueryPerformanceCounter Top
T = (Top - TopDépart) / DTop1sec
SMin = 1: SMax = 1: Visu 1: Me.Height = 54: Me.Caption = "Tirage réussi."
Select Case T
   Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
                  LabFait.Caption = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
      & M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
   Case Is < 60:  LabFait.Caption = "Dépêtré en " & Int(T * 10 + 0.5) / 10 & " seconde" & "."
   Case Else:     LabFait.Caption = "Achevé en " & DuréeEnClairSec(T) & "."
   End Select
Terminé = True: MessageBeep vbInformation: Décharger.PlanifierDans 5
End Sub
'

Function DuréeEnClairSec(ByVal DuRest As Double) As String
Dim U As Long, DuUnit As Double, NbUnit As Long, Niv As Long, Trad As String
For U = 1 To 7
  DuUnit = Choose(U, 31556952, 2629746, 604800, 86400, 3600, 60, 1)
  NbUnit = Int(DuRest / DuUnit)
  If NbUnit > 0 Or Niv > 0 Then Niv = Niv + 1: If Niv > 2 Then Exit Function
  If NbUnit > 0 Then
  Trad = NbUnit & " " & Choose(U, "an", "mois", "semaine", "jour", "heure", "minute", "seconde")
  If NbUnit * Choose(U, 1, 0, 1, 1, 1, 1, 1) > 1 Then Trad = Trad & "s"
  If Niv = 2 Then DuréeEnClairSec = DuréeEnClairSec & " et "
  DuréeEnClairSec = DuréeEnClairSec & Trad: End If
  DuRest = DuRest - DuUnit * NbUnit: Next U
End Function
End Sub
Peut être pouvez vous vous en inspirer…
 

eriiic

XLDnaute Barbatruc
Bonjour,

à noter cette page intéressante sur l'optimisation :
Ce lien n'existe plus
A chapitre 'Accélération des calculs dans les classeurs' ils te proposent des routines de mesures (avec QueryPerformanceFrequency également).
eric
 

Statistiques des forums

Discussions
311 721
Messages
2 081 928
Membres
101 842
dernier inscrit
seb0390