Affichage en direct du temps d'exécution d'une macro

Bonjour,

j'aimerais insérer dans une macro une sorte de "timer" qui me donne le temps d'exécution du programme en direct.

Je me base sur une macro que j'utilise mais dont je n'ai pas le détail. Sur la photo ci-dessous, le chrono se trouve tout en bas à gauche.

temps traitement macro

Merci de votre aide !

Cdt

clemcaze

bonjour Clemcaze

Tu dis : une macro dont je n'ai pas le détail ' qu'est-ce que cela veut dire?

tu as le code mais tu ne sais pas comment interagir.

la macro est dans un classeur protégé par mot de passe

. ..

merci de préciser

si dans la macro il y a une boucle dont le nombre de cycles est dénombrable, il y aura une solution

ou si le temps d'exécution est proportionnel à la quantité de données en entrée.

Bonjour

Essai ainsi :

Option Explicit

Sub Essai()
    Dim t1&, t2&
    Application.StatusBar = "Veuillez patienter..."
    t1 = Timer

    'instructions de la macro
    '...
    '...

    t2 = Timer
    Application.StatusBar = "Temps d'exécution de la macro en secondes :" & t2 - t1
End Sub

Bye !

Bonjour scraper,

il est vrai que me requête manquait de précisions :)

pour répondre à ta question : j'utilise une macro fournie par un fournisseur qui intègre dans son code un timer (comme vu en bas à gauche de mon image)

malheureusement, cette macro est protégée, je ne peux donc pas voir le code

j'utilise une seconde macro que j'ai réalisé dont le code est le suivant (désolé d'avance si elle est peu optimisée ^^) :

Sub TRI_PALETTES()
Application.ScreenUpdating = False

'Partie 1 : Suppression des colonnes inutiles
    Range("H:H,K:K,M:M,O:O,S:W").Select
    Selection.Delete Shift:=xlToLeft

'Partie 2 : Nommage des colonnes utiles
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "IT"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "NB OP"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Origine du flux"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "Code famille"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "OP"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "Partage"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "Secteur SCA"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "COUCHE ?"

'Partie 3 : Fonctions indépendantes
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R2C2:RC[-14],RC[-14])"

    Range("R2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(OR(ISNUMBER(SEARCH("" H"",RC[-12])),ISNUMBER(SEARCH(""/H"",RC[-12])),ISNUMBER(SEARCH(""-H"",RC[-12])),ISNUMBER(SEARCH("".H"",RC[-12])),ISNUMBER(SEARCH(""-Y"",RC[-12])),ISNUMBER(SEARCH(""/Y"",RC[-12])),ISNUMBER(SEARCH("".Y"",RC[-12]))),""PROMO"",""PERMANENT"")"

    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-12],5)"

'Partie 4 : Fonctions dépendantes de la BDD
    Range("T2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(NUMBERVALUE(RC[-1]),[PGC_BDD.xlsx]OPERATEURS!C1:C3,3,0)"

    Range("V2").Select
        ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-12],[PGC_BDD.xlsx]BDD_SCAOUEST!C1:C13,12,0)"

    Range("W2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-13],[PGC_BDD.xlsx]BDD_SCAOUEST!C1:C13,13,0)"

'Partie 3 : Fonctions indépendantes
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIFS(C2,RC[-15],C20,RC[3])=COUNTIF(C2,RC[-15]),""Opérateur unique"",""Plusieurs opérateurs"")"

    Range("U2").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIFS(C[-19],RC[-19],C[-1],RC[-1])&""/""&COUNTIF(C[-19],RC[-19])"

'Conversion du format pour RECHERCHEV
    Columns("J:J").Select
    Selection.NumberFormat = "0000000000000"
    Columns("J:J").Select
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

'Etendre les formules jusqu'au bout
Dim lig_fin As String

lig_fin = ActiveSheet.UsedRange.Rows.Count

    Range("P2").Copy
    Range(Range("P2"), Range("P2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("Q2").Copy
    Range(Range("Q2"), Range("Q2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("R2").Copy
    Range(Range("R2"), Range("R2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("S2").Copy
    Range(Range("S2"), Range("S2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("T2").Copy
    Range(Range("T2"), Range("T2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("U2").Copy
    Range(Range("U2"), Range("U2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("V2").Copy
    Range(Range("V2"), Range("V2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas
    Range("W2").Copy
    Range(Range("W2"), Range("W2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas

'Recopiage des valeurs
 Columns("P:W").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Masque des colonnes inutiles
   Range("W1").Select
    Selection.AutoFilter

    Cells.Select
    Cells.EntireColumn.AutoFit

    Range("C:E,H:H,L:O").Select
    Selection.EntireColumn.Hidden = True

    Range("F2").Select
    ActiveWindow.FreezePanes = True

'Insertion des pourcentages de partage des palettes
    Columns("V:V").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("X1").Select
    ActiveCell.FormulaR1C1 = "%"

    Columns("U:U").Select
    Selection.Copy
    Columns("V:V").Select
    ActiveSheet.Paste

    Columns("V:V").Select
    Selection.TextToColumns Destination:=Range("V1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

    Range("X2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]"

    Range("X2").Copy
    Range(Range("X2"), Range("X2").Offset(lig_fin - 2, 0)).PasteSpecial Paste:=xlPasteFormulas

    Columns("X:X").Select
    Selection.Style = "Percent"

    Columns("X:X").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Columns("V:W").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("P2").Select

Application.ScreenUpdating = True

End Sub

c'est donc sur cette macro perso que je souhaite intégrer un timer

Je teste le code de gmb et je reviens vers vous :)

Retour de test :

j'ai testé ton code gmb, ça marche très bien :)

Néanmoins cela ne me donne pas le pourcentage de progression ou le temps passé en direct (j'aimerais que cela soit visible pour les futurs utilisateurs de cette macro)

je me suis renseigné entre temps sur la création d'un userforme de barre de progression, qui répond également à mon besoin

Si je comprends bien, je suis bloqué car je ne sais pas à l'avance combien de lignes ma macro devra traiter à chaque utilisation ?

je suis bloqué car je ne sais pas à l'avance combien de lignes ma macro devra traiter à chaque utilisation ?

En effet...

En général, la solution que j'ai proposée est utilisée quand la macro fait un très grand nombre de boucles. A chaque tour, elle permet d'afficher le temps écoulé depuis le lancement.

Bye !

Rechercher des sujets similaires à "affichage direct temps execution macro"