code à améliorer[RESOLU]

moutchec · 2 Février 2019

bonjour le forum,
j'ai écrit ce code en m'inspirant des aides que j'ai déjà gentiment reçues sur ce site et il fonctionne mais met plus d'une minute pour afficher les résultats sur 172 lignes, on est qu'en janvier donc d'ici la fin de l'année j'aurai plus de 400 lignes et là je crains que ça rame plusieurs minutes.
quelqu'un aurait-il une astuce pour le faire aller plus vite?
merci d'avance...
Moutchec.

For z = 2 To Sheets("DONNEES").Range("A" & Rows.Count).End(xlUp).Row
For y = 3 To Sheets("MVTS").Range("A" & Rows.Count).End(xlUp).Row
If CStr(Sheets("DONNEES").Range("A" & z)) = CStr(Sheets("MVTS").Range("B" & y)) Then
Sheets("MVTS").Range("A" & y) = Sheets("DONNEES").Range("B" & z)
End If
Next
Next

Dranreb · 2 Février 2019

Bonjour.
Toujours pareil: ne jamais travailler directement avec les cellules, toujours passer par des tableaux dynamiques.
C'est facile: la propriété Value d'un Range de plusieurs cellule en est un justement.

M12 · 2 Février 2019

Bonjour,

Sans en voir plus et en savoir plus
si dès que la donnée est trouvée sur Sheets("MVTS") on recommence la boucle sur Sheets("DONNEES")
on place un
EXIT FOR juste avant le END IF

moutchec · 2 Février 2019

RE,
voici un exemple évidemment allégé.

Dranreb · 2 Février 2019

Le même algorithme que la procédure d'origine mais avec des tableaux dynamiques :

VB:

Private Sub CommandButton1_Click()
Dim RngD As Range, TD(), LD&, RngM As Range, TM(), LM&
With Worksheets("DONNEES"): Set RngD = .[A2].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 1, 2): End With
With Worksheets("MVTS"): Set RngM = .[A3].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 2, 2): End With
TD = RngD.Value
TM = RngM.Value
For LD = 1 To UBound(TD, 1)
   For LM = 1 To UBound(TM, 1)
      If CStr(TD(LD, 1)) = CStr(TM(LM, 2)) Then
         TM(LM, 1) = TD(LD, 2): End If: Next LM, LD
RngM.Columns("A").Value = TM
End Sub

Mais c'est sûr qu'on pourrait trouver de meilleurs algorithmes…

moutchec · 2 Février 2019

Dranreb à dit:

Le même algorithme que la procédure d'origine mais avec des tableaux dynamiques :

VB:

Private Sub CommandButton1_Click()
Dim RngD As Range, TD(), LD&, RngM As Range, TM(), LM&
With Worksheets("DONNEES"): Set RngD = .[A2].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 1, 2): End With
With Worksheets("MVTS"): Set RngM = .[A3].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 2, 2): End With
TD = RngD.Value
TM = RngM.Value
For LD = 1 To UBound(TD, 1)
   For LM = 1 To UBound(TM, 1)
      If CStr(TD(LD, 1)) = CStr(TM(LM, 2)) Then
         TM(LM, 1) = TD(LD, 2): End If: Next LM, LD
RngM.Columns("A").Value = TM
End Sub

Mais c'est sûr qu'on pourrait trouver de meilleurs algorithmes…

bonjour,
c'est parfait pour moi, ça met 2 secondes sur mon fichier contre plus d'une minute pour l'ancien code, fabuleux!!!!
merci bcp.
amicalement.
Moutchec.

Dranreb · 2 Février 2019

Ceci est encore bien plus rapide :

VB:

Private Sub CommandButton1_Click()
Dim RngD As Range, TD(), LD&, RngM As Range, TM(), LM&, Code&, CodMn&, CodMx&, TDsg()
With Worksheets("DONNEES"): Set RngD = .[A2].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 1, 2): End With
With Worksheets("MVTS"): Set RngM = .[A3].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 2, 2): End With
TD = RngD.Value
TM = RngM.Value
CodMx = 0: CodMn = &H7FFFFFFF
For LD = 1 To UBound(TD, 1)
   Code = TD(LD, 1)
   If CodMn > Code Then CodMn = Code
   If CodMx < Code Then CodMx = Code
   Next LD
ReDim TDsg(CodMn To CodMx)
For LD = 1 To UBound(TD, 1)
   Code = TD(LD, 1)
   If Code >= CodMn And Code <= CodMx Then TDsg(Code) = TD(LD, 2)
   Next LD
For LM = 1 To UBound(TM, 1)
   Code = TM(LM, 2)
   If Code >= CodMn And Code <= CodMx Then TM(LM, 1) = TDsg(Code)
   Next LM
RngM.Columns("A").Value = TM
End Sub

Mais ça ne peut marcher que si la fourchette entre le plus grand et le plus petit code reste assez raisonnable. Sinon on peut quand même appliquer le même principe en utilisant un Dictionary de la scrrun.dll (Bibliothèque Scripting, référence Microsoft Scripting Runtime)

moutchec · 2 Février 2019

Dranreb à dit:

Ceci est encore bien plus rapide :

VB:

Private Sub CommandButton1_Click()
Dim RngD As Range, TD(), LD&, RngM As Range, TM(), LM&, Code&, CodMn&, CodMx&, TDsg()
With Worksheets("DONNEES"): Set RngD = .[A2].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 1, 2): End With
With Worksheets("MVTS"): Set RngM = .[A3].Resize(.Cells(.Rows.Count, "A").End(xlUp).Row - 2, 2): End With
TD = RngD.Value
TM = RngM.Value
CodMx = 0: CodMn = &H7FFFFFFF
For LD = 1 To UBound(TD, 1)
   Code = TD(LD, 1)
   If CodMn > Code Then CodMn = Code
   If CodMx < Code Then CodMx = Code
   Next LD
ReDim TDsg(CodMn To CodMx)
For LD = 1 To UBound(TD, 1)
   Code = TD(LD, 1)
   If Code >= CodMn And Code <= CodMx Then TDsg(Code) = TD(LD, 2)
   Next LD
For LM = 1 To UBound(TM, 1)
   Code = TM(LM, 2)
   If Code >= CodMn And Code <= CodMx Then TM(LM, 1) = TDsg(Code)
   Next LM
RngM.Columns("A").Value = TM
End Sub

Mais ça ne peut marcher que si la fourchette entre le plus grand et le plus petit code reste assez raisonnable. Sinon on peut quand même appliquer le même principe en utilisant un Dictionary de la scrrun.dll (Bibliothèque Scripting, référence Microsoft Scripting Runtime)

bonjour @Dranreb ,
après tests, je préfère votre première proposition, elle marche bien et 2 secondes, honnêtement c'est difficile à battre, de plus n'étant pas très fort en excel, elle est plus lisible et plus compréhensible pour moi.
je vous remercie très sincèrement.
Moutchec.

code à améliorer[RESOLU]

moutchec

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

M12

XLDnaute Accro

moutchec

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

moutchec

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

moutchec

XLDnaute Occasionnel

Discussions similaires