demande amélioration code [RESOLU]

[Dudesson]

bonjour le forum, bonjour à tous,
je sollicite votre expertise pour corriger ce code qui apporte les bons résultats mais dont la partie en gras met pas mal de temps pour s’exécuter.
y aurait-il une autre approche pour obtenir la repose plus rapidement?
merci et bonnes fêtes
D. Pedro

Private Sub CommandButton1_Click()
Sheets("Compar").Range("L1:M" & Range("M" & Rows.Count).End(xlUp).Row).Delete Shift:=xlToLeft
For z = 6 To Sheets("Compar").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Compar").Range("L" & z) = Application.WorksheetFunction.Sum(Range("D" & z & ":K" & z))
For y = 4 To Sheets("Stocks").Range("C" & Rows.Count).End(xlUp).Row
If CStr(Sheets("Compar").Range("A" & z)) = CStr(Sheets("Stocks").Range("C" & y)) Then
Sheets("Compar").Range("M" & z) = Sheets("Stocks").Range("H" & y)
End If
Next
Next
End Sub

 

[mapomme]

Bonjour @Dudesson,

Vous avez sans doute omis de joindre le fichier...🙄

edit: bonjour @pierrejean 🙂

 

[Staple1600]

Bonjour le fil

ma pomme
Vous avez sans doute omis de conseiller le balisage BBCode du code de celui qui a omis de joindre un fichier 😉

PS: Et moi j'ai omis mon balisage [taquinerie du LDP][/Taquinerie] 😉

 

[pierrejean]

Bonjour Dudesson
Salut tapomme
Salut l'agrafe

Comme j'ai un peu de temps:
A tester:

Sub test1()
Sheets("Compar").Range("L1:M" & Range("M" & Rows.Count).End(xlUp).Row).Delete Shift:=xlToLeft
Tabcompar = Sheets("Compar").Range("A1:A" & Sheets("Compar").Range("A" & Rows.Count).End(xlUp).Row)
Tabres = Sheets("Compar").Range("M1:M" & Rows.Count)
TabH = Sheets("Stocks").Range("H1:H" & Rows.Count)
For Z = 6 To UBound(Tabcompar, 1)
Sheets("Compar").Range("L" & Z) = Application.WorksheetFunction.Sum(Range("D" & Z & ":K" & Z))
TabStocks = Sheets("Stocks").Range("C1:C" & Sheets("Stocks").Range("C" & Rows.Count).End(xlUp).Row)
For y = 4 To UBound(TabStocks, 1)
If Tabcompar(Z, 1) = TabStocks(y, 1) Then
Tabres(Z, 1) = TabH(y, 1)
End If
Next
Next
Sheets("Compar").Range("M1:M" & Rows.Count) = Tabres
End Sub

 

[Dranreb]

Bonjour.
Je ne le dirais jamais, jamais assez: ne travaillez jamais directement avec les cellules. Toujours qu'avec des tableaux VBA dynamiques..
Les méthodes Cells, Range et Evaluate sont horriblement lentes. Elle passent le plus clair de leurs temps à retrouver où sont stockées les données dans l'image en mémoire du classeur et non à transférer leurs valeurs. Par contre une fois qu'il a localisé où elles sont c'est rapide.
Vous pouvez donc pratiquement partir du principe, au moins dans le raisonnement conduisant à concevoir votre algorithme, que charger
400 000 fois une valeur d'une cellule dans une variable ou un élément de tableau, et bien ça dure 400 000 fois plus longtemps que de charger une seule fois dans tout le tableau la valeur de l'ensemble de la plage de 400 000 cellules !

 

[job75]

Bonjour à tous,

Ceci est très rapide :

Private Sub CommandButton1_Click()
Dim P As Range, Q As Range, tablo, d As Object, i&, x$
With Sheets("Compar")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .[L:M].ClearContents
    Set P = .Range("A6:M" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
If P.Row < 6 Then Exit Sub
P.Columns(12).FormulaR1C1 = "=SUM(RC4:RC11)": P.Columns(12) = P.Columns(12).Value
With Sheets("Stocks")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set Q = .Range("C4:H" & .Range("C" & Rows.Count).End(xlUp).Row)
End With
If Q.Row < 4 Then Exit Sub
tablo = Q 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    x = LCase(CStr(tablo(i, 1)))
    If x <> "" Then d(x) = tablo(i, 6)
Next
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    tablo(i, 13) = d(LCase(CStr(tablo(i, 1))))
Next
P.Columns(13) = Application.Index(tablo, , 13)
End Sub

A+

 

[Dudesson]

Bonjour.
Je ne le dirais jamais, jamais assez: ne travaillez jamais directement avec les cellules

bonjour et merci pour ce conseil, on me l'a déjà dit et c'est très exact, c'est juste que je suis en auto-apprentissage (avec aide des forums et des personnes généreuses que vous tous), donc un peu limité dans mes connaissances pour l'instant...
encore merci.

 

[Dudesson]

bonjour @pierrejean , @job75 ,
merci pour vos solutions, ça fait 2h que je planche dessus pour comprendre, c'est nickel.
sincères remerciements.
Pedro.