code VBA execution trop longue

B

bigmousse

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
CBernardT

CBernardT

XLDnaute Barbatruc
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 ?
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
B

bigmousse

XLDnaute Occasionnel
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...
 
Vote positif 0 Vote négatif
M

Mattharm

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
B

bigmousse

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
M

Mattharm

XLDnaute Occasionnel
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
Cliquez pour agrandir...

Et bien j'ai oublié les guillemets.... ;)

Code: 
TOTAL_LIGNE = Sheets(Ma_Feuille).Range([COLOR="Red"]"A" [/COLOR]& DEPART_LIGNE).End(xldown).Row
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
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????
(...)
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
B

bigmousse

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
103
Latias
L
D
  • Question
XL 2016 VBA format date
2
Réponses
17
Affichages
905
vgendron
vgendron
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
260
fanch55
fanch55
C
  • Résolu(e)
XL 2010 Delete
Réponses
5
Affichages
267
job75
job75
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
266
Compte Supprimé 979
C
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
260
florian50470
F
B
  • Résolu(e)
XL 2013 Comment inversé l'ordre d'enregistrement des lignes dans un tableau
Réponses
6
Affichages
213
bedley
B
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
176
rebatte
R
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
136
Phil69970
Phil69970
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
385
dadu35
D

Membres actuellement en ligne

13 membres et 92 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 392
Messages
2 087 988
Membres
103 691
dernier inscrit
christophe89