Améliorer vitesse éxécution

[Adriano43]

Bonjour à tous,

J'ai fais un code permettant d'analyser les valeurs de la 1ère colonne de chaque ligne. Si deux lignes ont des valeurs identiques, la macro effectue la somme de leurs cellules respectives en colonne D. Ma matrice comporte environ 200 lignes ce qui n'est pas énorme, mais la macro met un temps fou à s'éxécuter et arrive à planter mon pc.
Auriez-vous une idée pour améliorer mon code sachant que je n'ai jamais fait d'optimisation de code.
Voici le code en question:

Public Sub prcsomme()

Dim i As Integer
Application.ScreenUpdating = False
For i = 2 To 50
If Cells(i, 1) Like ("Page*") Then Rows(i).Delete
Do While Cells(i, 1) = Cells(i + 1, 1)
Cells(i, 4) = Cells(i, 4) + Cells(i + 1, 4) And _
Rows(i + 1).Delete
Loop
Next i
Application.ScreenUpdating = True
End Sub

Cordialement

Adriano43

 

[vgendron]

Re : Améliorer vitesse éxécution

Bonjour,

il nous manque ton fichier pour t'aider proprement,
peux tu stp, le joindre à ton post
merci

 

[Adriano43]

Re : Améliorer vitesse éxécution

Voici ci-joint un fichier exemple

 

[vgendron]

Re : Améliorer vitesse éxécution

à première vue..
il y a un souci. tu as deux boucles l'une dans l'autre: Do loop dans un for i..
la première boucle for i=2 to.. je vois bien, d'autant que tu incrémentes bien le i avec un Next i
par contre, le do while.. me semble inutile, surtout que le i ne s'incrémente pas dans cette boucle: un if serait sans doute suffisant

 

[Adriano43]

Re : Améliorer vitesse éxécution

J'ai remplacé le do while par une syntaxe en If mais seulement l'instruction ne s'éxécute qu'une seule fois, alors qu'avec le do while, la boucle traitait tout le fichier par simplement au premier doublon rencontré

 

[laetitia90]

Re : Améliorer vitesse éxécution

bonjour tous

brut comme cela

Sub es()
 Dim t(), i As Long, m As Object
  Set m = CreateObject("Scripting.Dictionary")
  t = Range("a2:b" & Cells(Rows.Count, 1).End(xlUp).Row)
  For i = 1 To UBound(t)
  m(t(i, 1)) = m(t(i, 1)) + t(i, 2)
  Next i
  [c2].Resize(m.Count) = Application.Transpose(m.keys)
  [d2].Resize(m.Count) = Application.Transpose(m.Items)
End Sub

 

[vgendron]

Re : Améliorer vitesse éxécution

bon,
déjà, en règle générale, lorsque dans une boucle, je m'amuse à supprimer des lignes.. je préfère toujours commencer par le bas en remontant. ca évite des problèmes de ligne oubliée..

avec le code suivant. ca ne semble pas planter. par contre. je ne comprend pas pourquoi la cellule en colonne A se trouve éffacée...

Public Sub prcsomme()

    Dim i As Integer
    Dim lastline As Integer
    
    lastline = Cells(2, 1).End(xlDown).Row
    Application.ScreenUpdating = False
    For i = lastline To 2 Step -1
    
    If Cells(i, 1) Like ("Page*") Then Rows(i).Delete
    Do While Cells(i, 1) = Cells(i - 1, 1)
        Cells(i, 2) = Cells(i, 2) + Cells(i - 1, 2) And Rows(i - 1).Delete
    Loop
    Next i
    Application.ScreenUpdating = True
End Sub

 

[vgendron]

Re : Améliorer vitesse éxécution

trouvé

Public Sub prcsomme()

    Dim i As Integer
    Dim lastline As Integer
    
    lastline = Cells(2, 1).End(xlDown).Row
    Application.ScreenUpdating = False
    For i = lastline To 2 Step -1
    
    If Cells(i, 1) Like ("Page*") Then Rows(i).Delete
    Do While Cells(i, 1) = Cells(i - 1, 1)
        Cells(i - 1, 2) = Cells(i, 2) + Cells(i - 1, 2) And Rows(i - 1).Delete
    Loop
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Adriano43]

Re : Améliorer vitesse éxécution

Merci de votre collaboration à tous les deux. Cependant, Vgendron, votre macro plante en me soulignant la ligne sous "Do while"...

 

[Adriano43]

Re : Améliorer vitesse éxécution

Personne pour m'aider à avancer sur ce sujet??
Je pensais sinon à définir une plage au début de la macro et faire appliquer cette dernière à la plage afin de limiter le champ d'action et ainsi réduire le temps d'éxécution.
Car j'ai tout simplement l'impression que la macro n'arrive pas à sortir de la boucle ce qui explique ce temps qui paraît infini...

 

[bof]

Re : Améliorer vitesse éxécution

bonjour,
Cette ligne est incorrecte :

Cells(i - 1, 2) = Cells(i, 2) + Cells(i - 1, 2) And Rows(i - 1).Delete

La première partie effectue une somme :

Cells(i - 1, 2) = Cells(i, 2) + Cells(i - 1, 2)

...mais le :

And Rows(i - 1).Delete

...n'à rien à voir dans l'histoire !
Si tu veux supprimer une ligne après avoir fait l'addition tu le fais sur la ligne suivante :

Rows(i).Delete 'et non pas i-1 (je suppose...)

A+

 

[laetitia90]

Re : Améliorer vitesse éxécution

re , tous salut bof

et si tu etais plus explicite tu crois pas que cela serait plus simple

J'ai fais un code permettant d'analyser les valeurs de la 1ère colonne de chaque ligne. Si deux lignes ont des valeurs identiques, la macro effectue la somme de leurs cellules respectives en colonne D.

tu renseigne la colonne D & tu delete la ligne??? mettre un exemple
en feuille1 tes donnees en feuille 2 le resultat attendu confidentielles ou pas on s'en fout

Personne pour m'aider à avancer sur ce sujet??

on en sait pas plus!!!!!!!!!!!!!!!!!


d'ailleurs je viens de me rendre compte que tu as pas repondu a un autre post poste lundi
c'est la moindre des politesses non tu crois pas!!!!!!!!!! je te mets dans ma BLACK.LIST

bon courage aux autres

 

[vgendron]

Re : Améliorer vitesse éxécution

Bonjour Adriano,
salut le fil

"la macro plante sous le do while".. je te suggère d'aller voir l'aide sur le do while... si tu n'incrémentes pas le compteur ca ne sert à RIEN
bof t'a signalé que ta syntaxe est erronée:

Cells(i - 1, 2) = Cells(i, 2) + Cells(i - 1, 2) And Rows(i - 1).Delete

et t'a expliqué pourquoi

maintenant, avec ce code: je ne vois pas de plantage

Public Sub prcsomme()

    Dim i As Integer
    Dim lastline As Integer
    
    lastline = Cells(2, 1).End(xlDown).Row
    Application.ScreenUpdating = False
    For i = lastline To 2 Step -1
    
    If Cells(i, 1) Like ("Page*") Then Rows(i).Delete
    
    If Cells(i, 1) = Cells(i - 1, 1) Then
        Cells(i - 1, 2) = Cells(i, 2) + Cells(i - 1, 2)
        Rows(i).Delete
    End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sans plus de détail de ta part (comme te le suggère laetitia), il n'y aura rien de plus