code VBA execution trop longue

bigmousse · 22 Avril 2010

Bonjour,
J'aimerais avoir votre avis concernant ce code :

Code:

Sub MAIN()
Dim MON_TOTAL_LIGNE As Integer
Dim MON_TOTAL_LIGNE_BD As Integer
Dim x, y As Integer
Dim Val1, Val2 As Integer


MON_TOTAL_LIGNE = TOTAL_LIGNE("Tableau de bord", 6)
MON_TOTAL_LIGNE_BD = TOTAL_LIGNE("Volume_Mag", 2)
y = 0
x = 0
Do While x < MON_TOTAL_LIGNE
    Do While y < MON_TOTAL_LIGNE_BD
        If Sheets("Tableau de bord").Cells(x + 6, 1) = Sheets("Volume_Mag").Cells(y + 2, 2) _
        And Sheets("Volume_Mag").Cells(y + 2, 4) = 1 Then
            Val1 = Val1 + Sheets("Volume_Mag").Cells(y + 2, 6)
        End If
        
        If Sheets("Tableau de bord").Cells(x + 6, 1) = Sheets("Volume_Mag").Cells(y + 2, 2) _
        And Sheets("Volume_Mag").Cells(y + 2, 4) = 2 Then
            Val2 = Val2 + Sheets("Volume_Mag").Cells(y + 2, 6)
        End If
     y = y + 1
    Loop
Sheets("Tableau de bord").Cells(x + 6, 9) = Val1 / Sheets("Tableau de bord").Cells(x + 6, 3)
Sheets("Tableau de bord").Cells(x + 6, 7) = Val2 / Sheets("Tableau de bord").Cells(x + 6, 3)
y = 0
Val1 = 0
Val2 = 0
x = x + 1
Loop
End Sub

Dans la 1ère boucle do while la variable MON_TOTAL_LIGNE peut atteindre des valeurs de l'ordre de la centaine.
Dans la seconde boucle do while la variable MON_TOTAL_LIGNE_BD peut atteindre des valeurs supérieures à 30 000.

Ce qui fait un total de plus de 3 millions de tests voir beaucoup plus si je compte les deux tests "IF".

Et lorsque j'execute ce code, en effet il dure plus de 7 minutes.
Comment peut-on optimiser ce code . Peut-on ramener l'execution de ce code à des temps beaucoup plus standard de l'ordre de la seconde ou de la minute sans faire appelle à un processeur quadruple corps à particule 🙂))
Merci
mousse

CBernardT · 22 Avril 2010

Re : code VBA execution trop longue

Bonjour bigmousse,

Dans les deux lignes de code suivantes :

MON_TOTAL_LIGNE = TOTAL_LIGNE("Tableau de bord", 6)
MON_TOTAL_LIGNE_BD = TOTAL_LIGNE("Volume_Mag", 2)

les premières variables sont définies avec deux autres variables non définies dans la macro. Comment sont-elles calculées ?

ROGER2327 · 22 Avril 2010

Re : code VBA execution trop longue

Bonjour à tous

Il est clair que si xpeut prendre de grandes valeurs, les deux lignes

Code:

[COLOR="DarkSlateGray"][B]Sheets("Tableau de bord").Cells(x + 6, 9) = Val1 / Sheets("Tableau de bord").Cells(x + 6, 3)
Sheets("Tableau de bord").Cells(x + 6, 7) = Val2 / Sheets("Tableau de bord").Cells(x + 6, 3)
[/B][/COLOR]

coûtent cher.
Il est probable que stocker les valeurs dans un ou des tableaux pendant les calculs, puis coller les valeurs dans la feuille en fin de procédure serait intéressant.
D'autres optimisation (moins sensibles) sont envisageables, mais il est difficile d'en dire plus avec une vue aussi partielle du projet.
Je propose cependant :

Code:

[COLOR="DarkSlateGray"][B]Sub MAIN()
Dim MON_TOTAL_LIGNE As Long
Dim MON_TOTAL_LIGNE_BD As Long
Dim x As Long, y As Long
Dim Val1, Val2 As Integer
Dim TdB1, TdB2


   MON_TOTAL_LIGNE = TOTAL_LIGNE("Tableau de bord", 6)
   MON_TOTAL_LIGNE_BD = TOTAL_LIGNE("Volume_Mag", 2)
   ReDim TdB1(0 To MON_TOTAL_LIGNE - 1, 1 To 1)
   ReDim TdB2(0 To MON_TOTAL_LIGNE - 1, 1 To 1)
   y = 0
   x = 0
   Do While x < MON_TOTAL_LIGNE
      Do While y < MON_TOTAL_LIGNE_BD
         If Sheets("Tableau de bord").Cells(x + 6, 1) = Sheets("Volume_Mag").Cells(y + 2, 2) _
            And Sheets("Volume_Mag").Cells(y + 2, 4) = 1 Then
            Val1 = Val1 + Sheets("Volume_Mag").Cells(y + 2, 6)
         End If
         
         If Sheets("Tableau de bord").Cells(x + 6, 1) = Sheets("Volume_Mag").Cells(y + 2, 2) _
            And Sheets("Volume_Mag").Cells(y + 2, 4) = 2 Then
            Val2 = Val2 + Sheets("Volume_Mag").Cells(y + 2, 6)
         End If
         y = y + 1
      Loop
      TdB1(x, 1) = Val1 / Sheets("Tableau de bord").Cells(x + 6, 3)
      TdB2(x, 2) = Val2 / Sheets("Tableau de bord").Cells(x + 6, 3)
      y = 0
      Val1 = 0
      Val2 = 0
      x = x + 1
   Loop
   Sheets("Tableau de bord").Cells(6, 9).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1
   Sheets("Tableau de bord").Cells(6, 7).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1
End Sub[/B][/COLOR]

Évidemment pas testé, en l'absence de support. Donc :
À TESTER AVEC PRECAUTION !
(d'autant que, apparemment, cette procédure en appelle d'autres dont on ne sait rien...)

ROGER2327
#3283

bigmousse · 22 Avril 2010

Re : code VBA execution trop longue

OUAHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
Merci à toi ROGER2327
ça à l'air de marcher et plus rapide, je test avec ma base qui compte plus de 20000 enregistrements ...
Cependant, je ne comprends pas trop cette formulation :

Code:

Sheets("Tableau de bord").Cells(6, 9).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1
   Sheets("Tableau de bord").Cells(6, 7).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1

On peut entrer toutes les valeurs d'un tableau sans passer par une boucle FOR ou Do while????

Merci pour ta reponse CBernardT et voici la reponse à ta question :

Code:

Function TOTAL_LIGNE(Ma_Feuille As String, DEPART_LIGNE As Integer) As Integer 'Compter le nombre de ligne dans le tableau Donnees
Dim x As Integer
x = DEPART_LIGNE
Do While Sheets(Ma_Feuille).Cells(x, 1) <> ""
    x = x + 1
Loop
TOTAL_LIGNE = x - DEPART_LIGNE
End Function

Je vous tiens au courant pour la suite...

Mattharm · 22 Avril 2010

Re : code VBA execution trop longue

Salut

Pour connaître la dernière ligne (et donc le nombre de ligne) :

Code:

Function TOTAL_LIGNE(Ma_Feuille As String, DEPART_LIGNE As Integer) As Integer 'Compter le nombre de ligne dans le tableau Donnees
TOTAL_LIGNE = Sheets(Ma_Feuille).Range(A & DEPART_LIGNE).End(xldown).Row
End Function

bigmousse · 22 Avril 2010

Re : code VBA execution trop longue

Code:

TOTAL_LIGNE = Sheets(Ma_Feuille).Range([COLOR="Red"]A [/COLOR]& DEPART_LIGNE).End(xldown).Row

Interessant Mattharm, mais comment fais-tu pour que VBA le me considère pas le A comme une variable...???
Merci

Mattharm · 22 Avril 2010

Re : code VBA execution trop longue

bigmousse à dit:
Code:

TOTAL_LIGNE = Sheets(Ma_Feuille).Range([COLOR="Red"]A [/COLOR]& DEPART_LIGNE).End(xldown).Row

Interessant Mattharm, mais comment fais-tu pour que VBA le me considère pas le A comme une variable...???
Merci

Et bien j'ai oublié les guillemets.... 😉

Code:

TOTAL_LIGNE = Sheets(Ma_Feuille).Range([COLOR="Red"]"A" [/COLOR]& DEPART_LIGNE).End(xldown).Row

bigmousse · 22 Avril 2010

Re : code VBA execution trop longue

ah merci bête je suis🙂

ROGER2327 · 22 Avril 2010

Re : code VBA execution trop longue

Re...

bigmousse à dit:
(...)
ds pas trop cette formulation :

Code:

Sheets("Tableau de bord").Cells(6, 9).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1 Sheets("Tableau de bord").Cells(6, 7).Resize(MON_TOTAL_LIGNE, 1).Value = TdB1

On peut entrer toutes les valeurs d'un tableau sans passer par une boucle FOR ou Do while????
(...)

Sheets("Tableau de bord").Cells(6, 9).Resize(MON_TOTAL_LIGNE, 1) définit une plage ayant les mêmes dimensions que le tableau TdB1 et on y colle effectivement le tableau en une seule passe.
Si le tableau a beaucoup de lignes, ça peut prendre un certain temps.
A propos de temps, vous disiez que votre procédure pouvait prendre 7 minutes. Pour mon information personnelle, pourriez-vous me dire le temps que prend la nouvelle procédure ?
Merci d'avance.

ROGER2327
#3300

bigmousse · 23 Avril 2010

Re : code VBA execution trop longue

Bonjour Roger
Pour info la procedure envoyé prends un peu moins autour de 6 minutes.
J'ai changer un peu mon code j'ai gagné un peu je passe à 4 minutes (en passant par un tableau, tu avais raison), j'ai fait une inversion car Mon_total_ligne_BD peut prendre des valeurs de l'ordre de 20000 à 30000 alors que Mon_total_ligne la centaine.
L'objectif est de balayer une seule fois les 20 000 lignes. Les donnes de mon tableau de bord sont uniques, dès que je trouve l'égalité je sort de ma boucle.Alors que les données dans Volum_mag peuvent être en doublons.

Les tableaux => feuille de calcule
Pour rentrer toutes les valeur sans passer par une boucle, effectivement c'est trés efficace, par contre je n'ai pas su le reproduire avec un tableau à deux dimensions.

Code:

Function TOTAL_LIGNE(Ma_Feuille As String, DEPART_LIGNE As Integer) As Integer 'Compter le nombre de ligne dans le tableau Donnees
Dim x As Integer
x = DEPART_LIGNE
Do While Sheets(Ma_Feuille).Cells(x, 1) <> ""
    x = x + 1
Loop
TOTAL_LIGNE = x - DEPART_LIGNE
End Function



Sub MAIN()
Dim MON_TOTAL_LIGNE As Long
Dim MON_TOTAL_LIGNE_BD As Long
Dim x As Long, y As Long
Dim Val1, Val2 As Integer
Dim TdB1, TdB2
Dim TdB3


Application.DisplayStatusBar = True



   MON_TOTAL_LIGNE = TOTAL_LIGNE("Tableau de bord", 6)
   MON_TOTAL_LIGNE_BD = TOTAL_LIGNE("Volume_Mag", 2)
   'ReDim TdB1(0 To MON_TOTAL_LIGNE - 1, 1 To 1)
   'ReDim TdB2(0 To MON_TOTAL_LIGNE - 1, 1 To 1)
   ReDim TdB3(0 To MON_TOTAL_LIGNE - 1, 0 To 2)
   
   Do While x < MON_TOTAL_LIGNE
   TdB3(x, 0) = Sheets("Tableau de bord").Cells(x + 6, 1)
   x = x + 1
   Loop
     
   
   y = 0
   x = 0
   
      Do While y < MON_TOTAL_LIGNE_BD
        Do While x < MON_TOTAL_LIGNE
         If TdB3(x, 0) = Sheets("Volume_Mag").Cells(y + 2, 2) _
            And Sheets("Volume_Mag").Cells(y + 2, 4) = 1 Then
            TdB3(x, 1) = TdB3(x, 1) + Sheets("Volume_Mag").Cells(y + 2, 6)
            Exit Do
         End If
         
         If TdB3(x, 0) = Sheets("Volume_Mag").Cells(y + 2, 2) _
            And Sheets("Volume_Mag").Cells(y + 2, 4) = 2 Then
            TdB3(x, 2) = TdB3(x, 2) + Sheets("Volume_Mag").Cells(y + 2, 6)
            Exit Do
         End If
         x = x + 1
      Loop
      
      x = 0
      y = y + 1
      Application.StatusBar = y
   Loop
   
   
   Do While x < MON_TOTAL_LIGNE
   Sheets("Tableau de bord").Cells(x + 6, 9) = TdB3(x, 1) / Sheets("Tableau de bord").Cells(x + 6, 3)
   Sheets("Tableau de bord").Cells(x + 6, 7) = TdB3(x, 2) / Sheets("Tableau de bord").Cells(x + 6, 3)
   x = x + 1
   Loop
   
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
   
   
   
End Sub

Effectuez une recherche sur Excel Downloads...

code VBA execution trop longue

bigmousse

XLDnaute Occasionnel

CBernardT

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

bigmousse

XLDnaute Occasionnel

Mattharm

XLDnaute Occasionnel

bigmousse

XLDnaute Occasionnel

Mattharm

XLDnaute Occasionnel

bigmousse

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

bigmousse

XLDnaute Occasionnel

Discussions similaires

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