demande amélioration code [RESOLU]

Dudesson

XLDnaute Junior
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
 

pierrejean

XLDnaute Barbatruc
Bonjour Dudesson
Salut tapomme
Salut l'agrafe

Comme j'ai un peu de temps:
A tester:
Code:
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

XLDnaute Barbatruc
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 !
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Ceci est très rapide :
VB:
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+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG