Accélérer un code

Wylsonn · 17 Avril 2009

Bonjour,

J'ai un souci avec le code ci-dessous : avec 1000 répétitions de la boucle principale ("AM10=1000"), j'en ai approximativement pour 24 heures à faire tourner la machine (Intel Core 2 duo à 2,2 GHz - Windows XP sur MacBook Pro) !! et je dois faire ça sur une vingtaine de feuilles...

A l'expérience, avez-vous une ou des idées pour gagner du temps de traitement ? quelques fractions de seconde par calcul feront au bout quelques heures en moins... 😱

Sub BBD()

Workbooks("ABONNEMENT.xls").Sheets("Calcul").Activate

Dim A As Currency, B As Currency, C As Currency, D As Integer, E As Integer, F As Integer

For F = 0 To 8 * Range("AM10").Value Step 8

Range("T248").End(xlDown).Select
If Range("T248") = Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 +
Selection.Row - 8
D = 20

Cells(E + F, D).Select
Range("Pour").Value = Cells(E + F, D - 3).Value
Range("cumul1").Value = Cells(E + F, D - 2).Value
Range("retard").Value = Cells(E + F, D - 1).Value
A = -0.8
B = -0.15
C = -0.12

For C = -0.12 To 0.15 Step 0.03
If Range("Seuil").Value > 0.76 Then Range("Seuil").Value = -0.15
Range("Seuil").Value = C

For B = -0.15 To 0.76 Step 0.1
If Range("version").Value > 0.76 Then Range("version").Value =
-0.15
Range("version").Value = B

For A = -0.8 To 0.6 Step 0.2
If Range("cumul2").Value > 0.6 Then Range("cumul2").Value = -0.8
Range("cumul2").Value = A
Cells(E + F, D).Select
Range("H2").Copy
Selection.PasteSpecial Paste:=xlPasteValues
E = E + 1
Next A

E = E - 8
D = D + 1

Next B

Next C

Next F

End Sub

Le résultat génère le tableau joint comme exemple, mais répété près d'un millier de fois. Comme chaque résultat est le produit du traitement d'une base de données, cela entraîne un processus lent (un bloc de 8 lignes est généré en à peu près 1'30").

Tout gain de temps, si minime soit-il, est le bienvenu !!🙂

JNP · 17 Avril 2009

Re : Accélérer un code

Bonjour Wylsonn 🙂,
Met

Code:

Application.ScreenUpdating = False

au début de ta macro et

Code:

Application.ScreenUpdating = True

à la fin. L'accélération va déjà être considérable.
Bonne fin de journée 😎

Wylsonn · 17 Avril 2009

Re : Accélérer un code

Merci JNP, je gagne effectivement environ 30 % de temps de traitement en plaçant les 2 instructions à l'intérieur de la boucle externe (histoire de voir quand même la progression régulière des calculs, et non pas au bout de plusieurs heures...).

Si d'autres ont aussi d'excellentes idées, je reste preneur !

Bonne soirée

vbacrumble · 17 Avril 2009

Re : Accélérer un code

Bonsoir

Pourquoi pas
If IsEmpty(Range("T248") Then E = 248 Else E = 1 +
Selection.Row - 8
au lieu de
If Range("T248") = Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 +
Selection.Row - 8

Perso, j'éviterai tous les Select

Wylsonn · 17 Avril 2009

Re : Accélérer un code

Même si dans ce cas le gain n'est pas mesurable, c'est effectivement un code plus propre !

Merci et A+

vbacrumble · 17 Avril 2009

Re : Accélérer un code

Re

Essaie de modifier ton code en évitant les Select et Activate

l'exécution de ton code sera plus rapide

Bernard_XLD · 17 Avril 2009

Re : Accélérer un code

Salut Wilson, le forum

voila ton code un peu épuré, devrait aller plus vite, aprés pour gagner en vitesse, utilises des variables pour tes tests au lieu de stocker tes valeurs intermédiaires dans les cellules, ne mets à jour tes cellules qu'à la dernière valeur.

@+

Code:

Sub BBD()
Dim A As Currency, B As Currency, C As Currency, D As Integer, E As Integer, F As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Workbooks("ABONNEMENT.xls").Sheets("Calcul")
    For F = 0 To 8 * .Range("AM10").Value Step 8
        If .Range("T248") = .Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 + .Range("T248").End(xlDown).Row - 8
        D = 20
        .Range("Pour").Value = .Cells(E + F, D - 3).Value
        .Range("cumul1").Value = .Cells(E + F, D - 2).Value
        .Range("retard").Value = .Cells(E + F, D - 1).Value
        A = -0.8
        B = -0.15
        C = -0.12
        For C = -0.12 To 0.15 Step 0.03
            If .Range("Seuil").Value > 0.76 Then .Range("Seuil").Value = -0.15
            .Range("Seuil").Value = C
            For B = -0.15 To 0.76 Step 0.1
                If .Range("version").Value > 0.76 Then .Range("version").Value = -0.15
                .Range("version").Value = B
                For A = -0.8 To 0.6 Step 0.2
                    If .Range("cumul2").Value > 0.6 Then .Range("cumul2").Value = -0.8
                    .Range("cumul2").Value = A
                    .Cells(E + F, D).Value = .Range("H2").Value
                    E = E + 1
                Next A
                E = E - 8
                D = D + 1
            Next B
        Next C
    Next F
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Wylsonn · 17 Avril 2009

Re : Accélérer un code

La suppression des Select et Activate fait encore gagner quelques %, mais la mise en place du calcul manuel produit des "H2" identiques, ce qui fait que je génère un tableau d'une constante (!), certes très rapidement...

Le recalcul doit malheureusement se faire à chaque boucle, sinon c'est la la même valeur de "H2" qui est reproduite x fois.

Très bonne soirée à toi

ROGER2327 · 17 Avril 2009

Re : Accélérer un code

Bonsoir à tous

Ce code contient beaucoup de choses inutiles :

Code:

Sub BBD()
Dim A As Currency, B As Currency, C As Currency, D As Integer, E As Integer, F As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Workbooks("ABONNEMENT.xls").Sheets("Calcul")
    For F = 0 To 8 * .Range("AM10").Value Step 8
        If .Range("T248") = .Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 + .Range("T248").End(xlDown).Row - 8
        D = 20
        [U].Range("Pour").Value = .Cells(E + F, D - 3).Value[/U] [COLOR="SeaGreen"]'INUTILE / "Pour" n'est employé nulle part[/COLOR]
        [U].Range("cumul1").Value = .Cells(E + F, D - 2).Value[/U] [COLOR="SeaGreen"]'INUTILE / "cumul1" n'est employé nulle part[/COLOR]
        [U].Range("retard").Value = .Cells(E + F, D - 1).Value[/U] [COLOR="SeaGreen"]'INUTILE / "retard" n'est employé nulle part'[/COLOR]***
        [U]A = -0.8[/U] [COLOR="SeaGreen"]'INUTILE / A sera initialisé ligne *[/COLOR]
        [U]B = -0.15[/U] [COLOR="SeaGreen"]'INUTILE / B sera initialisé ligne **[/COLOR]
        [U]C = -0.12[/U] [COLOR="SeaGreen"]'INUTILE / C sera initialisé ligne ***[/COLOR]
        For C = -0.12 To 0.15 Step 0.03 [COLOR="SeaGreen"]'***[/COLOR]
            [U]If .Range("Seuil").Value > 0.76 Then .Range("Seuil").Value = -0.15[/U] [COLOR="SeaGreen"]'INUTILE / Voir ligne suivante[/COLOR]
            [U].Range("Seuil").Value = C[/U] [COLOR="SeaGreen"]'INUTILE / "Seuil1" n'est employé nulle part[/COLOR]
            For B = -0.15 To 0.76 Step 0.1 [COLOR="SeaGreen"]'**[/COLOR]
                [U]If .Range("version").Value > 0.76 Then .Range("version").Value = -0.15[/U][COLOR="SeaGreen"] 'INUTILE / Voir ligne suivante[/COLOR]
                [U].Range("version").Value = B[/U] [COLOR="SeaGreen"]'INUTILE / "version" n'est employé nulle part[/COLOR]
                For A = -0.8 To 0.6 Step 0.2 [COLOR="SeaGreen"]'*[/COLOR]
                    [U]If .Range("cumul2").Value > 0.6 Then .Range("cumul2").Value = -0.8[/U] [COLOR="SeaGreen"]'INUTILE / Voir ligne suivante[/COLOR]
                    [U].Range("cumul2").Value = A[/U] [COLOR="SeaGreen"]'INUTILE / "cumul2" n'est employé nulle part[/COLOR]
                    .Cells(E + F, D).Value = .Range("H2").Value
                    E = E + 1
                Next A
                E = E - 8
                D = D + 1
            Next B
        Next C
    Next F
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Il reste finalement ce code

Code:

Sub BBD2()
Dim A As Currency, B As Currency, C As Currency, D As Integer, E As Integer, F As Integer
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   With Workbooks("ABONNEMENT.xls").Sheets("Calcul")
      For F = 0 To 8 * .Range("AM10").Value Step 8
         If .Range("T248") = .Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 + .Range("T248").End(xlDown).Row - 8
         D = 20
         For C = -0.12 To 0.15 Step 0.03
            For B = -0.15 To 0.76 Step 0.1
               For A = -0.8 To 0.6 Step 0.2
                  .Cells(E + F, D).Value = .Range("H2").Value
                  E = E + 1
               Next A
               E = E - 8
               D = D + 1
            Next B
         Next C
      Next F
   End With
   Application.Calculation = xlCalculationAutomatic
End Sub

...et une question : à quoi cela sert-il ?

Bonne nuit !
ROGER2327

Wylsonn · 18 Avril 2009

Re : Accélérer un code

Merci Roger; effectivement, la définition des valeurs pour A, B, C est inutile, ainsi que les "If...". Pour le reste, les "Range" définissent des valeurs en-dehors du tableau pour construire les paramètres qui serviront à générer des "H2" itérés : sans eux, mes "H2" auraient toujours la même valeur, ce qui serait sans intérêt.

Très bonne journée à tous, même sous la pluie...

Bernard_XLD · 18 Avril 2009

Re : Accélérer un code

pour le recalcul intermédiaire, mets des instructions
.Calculate
quand tu as besoin, cela restera plus rapide que d'activer le calcul automatique et ne recalculera que la feuille abonnement

@+

Bernard_XLD · 18 Avril 2009

Re : Accélérer un code

on peut même ne recalculer que la cellule necessaire ce qui est encore mieux pour la rapidité, exemple
.Range("Seuil").Calculate

Wylsonn · 18 Avril 2009

Re : Accélérer un code

Excellente astuce... je viens de diviser le temps de traitement par 2 !! tu viens de me faire économiser 16 jours de travail 🙂 & mon ordi se joint à moi pour te remercier...

A noter que si l'on interrompt manuellement la macro pendant son exécution, il ne faut pas oublier de réactiver le calcul automatique.

Bon week-end à tous

ROGER2327 · 18 Avril 2009

Re : Accélérer un code

Bonsoir à tous

Je pense que ce code

Code:

Sub BBD4()
Dim A As Currency, B As Currency, C As Currency, D As Integer, E As Long, F As Integer
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   With Workbooks("ABONNEMENT.xls").Sheets("Calcul")
      For F = 0 To 8 * .Range("AM10").Value Step 8
         If .Range("T248") = .Cells(xlCellTypeBlanks) Then E = 248 Else E = 1 + .Range("T248").End(xlDown).Row - 8
         .Range(.Cells(E + F, 20), .Cells(E + F + 7, 119)).Value = .Range("H2").Value
      Next F
   End With
   Application.Calculation = xlCalculationAutomatic
End Sub

devrait être nettement plus rapide.

Bonne soirée !
ROGER2327

Wylsonn · 18 Avril 2009

Re : Accélérer un code

Travailler avec une matrice est une bonne idée, mais comment peuvent varier mes variables A, B et C dans le code que tu proposes ?

Bonne soirée

Effectuez une recherche sur Excel Downloads...

Accélérer un code

Wylsonn

XLDnaute Nouveau

Pièces jointes

JNP

XLDnaute Barbatruc

Wylsonn

XLDnaute Nouveau

vbacrumble

XLDnaute Accro

Wylsonn

XLDnaute Nouveau

vbacrumble

XLDnaute Accro

Bernard_XLD

XLDnaute Barbatruc

Wylsonn

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

Wylsonn

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

Wylsonn

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

Wylsonn

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée