Accélérer l'excécution du code

Bonjour à tous

J ai le code suivant et je souhaiterais savoir s'il est possible d'accélérer le temps d'exécution du code

Comme écrit ci dessous il faut environ 4mns 40 environ

merci d'avance pour votre aide

Option Explicit

Dim f, ln, lgn, n, i

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Call MAJ_Feuil2
    Set f = Sheets("Feuil2")
    f.Range("A1").CurrentRegion.Offset(3, 0).Clear
    For ln = 3 To Range("A" & Rows.Count).End(xlUp).Row
        n = Year(Range("G" & ln)) - Year(Range("D" & ln)) + 1
        lgn = Application.Max(3, f.Range("A" & Rows.Count).End(xlUp)(2).Row)
        Range("A" & ln & ":AE" & ln).Copy
        f.Range("A" & lgn & ":AE" & lgn + n - 1).PasteSpecial xlPasteAll
        For i = 0 To n - 1
            f.Range("O" & lgn + i) = Year(f.Range("D" & lgn)) + i
        Next i
    Next ln
    Application.CutCopyMode = False
    f.Select

End Sub

Sub MAJ_Feuil2()

Sheets("Feuil2").Select
Range("A3:Q10000").Select
    Selection.ClearContents
    Sheets("Feuil1").Select
    Range("A3").Select
End Sub[code]

Bonsoir,

je prends la partie la plus facile

Sub MAJ_Feuil2()
Sheets("Feuil2").Range("A3:Q10000").ClearContents
Range("A3").Select
End Sub

En effet pour travailler sur des cellules il n'est pas besoin de les activées ou de les sélectionner

Pour la suite...

@ bientôt

LouReeD

En fait sans les feil1 et feuil2 j'ai du mal à saisir le truc...

Possibilité de mettre le fichier en pièce jointe, merci

@ bientôt

LouReeD

Bonsoir

merci pour ta réponse

ci joint le classeur correspondant

mais j ai supprimé les données initiales

en réalité la feuille 1 contient beaucoup plus de données d'où la lenteur d'exécution du code ( initialement la feuille comporte 1500 lignes environ

merci d'avance

Bonsoir,

Essaie ceci.

Supprimer les déclarations de variables niveau module (on les réintègre dans la procédure).

Et tu peux supprimer ta Sub MAJ_Feuil2 qui fait double emploi.

Private Sub CommandButton2_Click()
    Dim f As Worksheet, ln%, lgn%, n%, i%, a%
    Set f = Worksheets("Feuil2")
    f.Range("A1").CurrentRegion.Offset(2).Clear
    lgn = 3
    Application.ScreenUpdating = False
    With Me
        For ln = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
            a = Year(.Range("D" & ln)): n = Year(.Range("G" & ln)) - a
            .Range("A" & ln & ":AE" & ln).Copy f.Range("A" & lgn & ":A" & lgn + n)
            For i = 0 To n
                f.Range("O" & lgn + i) = a + i
            Next i
            lgn = lgn + n + 1
        Next ln
    End With
    f.Activate
End Sub

J'ai éliminé le maximum de calculs intermédiaires et revenu à un collage normal puisque tu colles tout sans particularités.

Cela devrait un peu améliorer j'espère, mais comme tu reproduis les formats et formule, on doit maintenir le copier-coller et on ne bénéficie donc pas de la possibilité de travailler en tableaux hors Excel...

Ceci dit, plus de 4 minutes pour seulement 1500 lignes, même avec l'ancien code cela me paraît excessif ! Il y a peut-être un autre problème dans le classeur, qui ne relève pas du code.

Cordialement.

Bonjour MFerrand

merci pour ton aide

je vais le tester et je reviendrai vers toi pour la suite

merci encore

bonne journée !!!

Test concluant

au final le nouveau code fait le travail en 43 secondes et l'ancien 1mn 35

En fait je pense que les 4 minutes vient de la lenteur de notre réseau dans mon travail...

La je l ai testé hors réseau

merci encore

petite question supplémentaire,

si je souhaite arrêter la procédure par un bouton "annuler" alors que le code est déjà lancé pourriez vous m indiquer le code svp

merci

Bonjour,

Les temps que tu donnes pour l'exécution des codes me paraissent beaucoup plus cohérents... Le rapport entre les deux me semble assez bien correspondre aux opérations que j'ai pu supprimer... Comme je l'avais dit on a un gain déjà sensible et qui me paraît satisfaisant, mais rien de foudroyant (mais ça je doute que l'on puisse y parvenir).

Si tu veux interrompre la procédure en cours en appuyant sur un bouton, tu peux essayer un système simple :

- une variable booléenne déclarée au niveau module, par exemple :

Dim interrupt As Boolean

- une procédure attachée au bouton d'interruption, qui passera cette variable à True lorsque tu veux interrompre :

Sub Interrompre()
    interrupt = True
End Sub

- dans ta procédure à interrompre, c'est à l'intérieur de la boucle que tu dois intervenir pour arrêter le processus, par exemple en fin d'un tour, avant le Next ln, tu introduis un DoEvents destiné à redonner la main au système avant de poursuivre, ce qui provoquera l'exécution des commandes en attente, et tu testes la valeur de la variable : si elle est à True, tu sors de la procédure.

            DoEvents
            If interrupt Then interrupt = False: Exit Sub
        Next Ln

C'est à tester dans le contexte...

Cordialement.

Très bien

merci pour tes bons conseils !!!

bien cordialement

une fois le code lancée, il ne m est pas possible activer le bouton qui active l'annulation de la procédure ...

Bonjour,

Une petite démo du mécanisme.

Un bouton Essai lance une procédure qui fait une boucle de 1 à 10. A l'intérieur une boucle de 1 à 30 000 000 assez rapide vu qu'elle se déroule à vide (trop peut-être car pour arrêter à l'étape 1, il ne faut pas musarder avant de cliquer sur le bouton Stop, mais on peut augmenter à 50 ou 100 millions pour ralentir un peu...)

A la suite de cette boucle, elle inscrit en colonne A : Etape 1, puis 2, etc. jusqu'à 10. Si on appuie sur Stop, elle va s'arrêter...

Cordialement.

ouh la la !!!

Je vais devoir me creuser la tête là ...

mais çà me va comme exercice

et moi qui devait monter voir le volcan ...

et moi qui devait monter voir le volcan ...

Choisis tes priorités, les conditions vont se dégrader...

Bonjour

j ai essayé le code suivant mais toujours pas possible d'actionner le bouton qui arrête le déroulement du code

Je pense avoir mis le DoEvents au bon endroit pourtant...

Merci d'avance pour votre aide

cordialement

Dim sstop As Boolean
Private Sub CommandButton4_Click()
sstop = True
End Sub

Private Sub CommandButton3_Click()
Dim f As Worksheet, ln%, lgn%, n%, i%, a%, j%
    Set f = Worksheets("Feuil2")
    f.Range("A1").CurrentRegion.Offset(2).Clear
    sstop = False
    lgn = 3
    Application.ScreenUpdating = False
    With Me
        For ln = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
             a = Year(.Range("D" & ln)): n = Year(.Range("G" & ln)) - a
            .Range("A" & ln & ":AE" & ln).Copy f.Range("A" & lgn & ":A" & lgn + n)
            For i = 0 To n
            f.Range("O" & lgn + i) = a + i
            Next i
            lgn = lgn + n + 1
                DoEvents
                If sstop Then
                MsgBox "arrêt": Exit Sub
                End If
        Next ln
    End With
    f.Activate

End Sub

Il manque le rétablissement de la variable à False. Tu peux le mettre en début de procédure, au moins pas de surprise inverse (qu'elle se trouve à True et que ça s'arrête alors que tu ne veux pas... !)

Mais ce n'est pas le problème actuel... Essaie de rattacher la macro stop à un bouton de formulaire, pour voir.

Jai créé le bouton et je l ai rattaché a un bouton de formulaire mais çà ne fonctionne toujours pas

comment je rétablis la variable a False stp

merci

Tu mets après les déclarations, et avant la boucle :

    sstop = False

Mais je ne vois toujours pas pourquoi tu ne peux utiliser ton bouton ?

J'ai transféré ma démo sur des boutons activeX, tout le code dans le module de feuille, pour être dans des conditions comparables et ça fonctionne de la même façon.