Lenteur d’exécution du code

**atk_49** · 22/03/2019, 09h06

Bonjour,

Un module contient du code composé de plusieurs boucles For récupérant des données dans un tableau (commandes) d'environ 5000 lignes, rien d'incroyable.

Lorsque je démarre excel pour le première fois, le code s’exécute rapidement (environ 2 secondes) puis lorsque j’exécute le même code une seconde fois, il dure environ 30 secondes pour un résultat identique.

J'ai placé quelques "Doevents à la fin des boucles les plus importantes, un End à la fin du module, et Option Explicit en début de module pour assurer la déclaration des variables, mais rien n'y fait.

Auriez-vous une explication à cela ?

Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Option Explicit
Sub Details()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
 
'PREMIÈRE OPÉRATION : Page Détails N-1
ThisWorkbook.Sheets("Détails N-1").Range("A:C").ClearContents
'Récupération des commandes par clients selon critères
If ThisWorkbook.Sheets("Statistiques client").Range("E2") = "Totaux" Then
For k = 1 To ThisWorkbook.Sheets("Commandes").Range("A" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Sheets("Commandes").Cells(k, 3) >= ThisWorkbook.Sheets("Statistiques").Range("A2") And ThisWorkbook.Sheets("Commandes").Cells(k, 3) <= ThisWorkbook.Sheets("Statistiques").Range("B2") Then
ThisWorkbook.Sheets("Détails N-1").Cells(ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = ThisWorkbook.Sheets("Commandes").Cells(k, 4)
ThisWorkbook.Sheets("Détails N-1").Cells(ThisWorkbook.Sheets("Détails N-1").Range("B" & Rows.Count).End(xlUp).Row + 1, 2) = ThisWorkbook.Sheets("Commandes").Cells(k, 2)
End If
Next k
Else
For k = 1 To ThisWorkbook.Sheets("Commandes").Range("A" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Sheets("Commandes").Cells(k, 5) = ThisWorkbook.Sheets("Statistiques client").Range("E2") And _
ThisWorkbook.Sheets("Commandes").Cells(k, 3) >= ThisWorkbook.Sheets("Statistiques").Range("A2") And ThisWorkbook.Sheets("Commandes").Cells(k, 3) <= ThisWorkbook.Sheets("Statistiques").Range("B2") Then
ThisWorkbook.Sheets("Détails N-1").Cells(ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = ThisWorkbook.Sheets("Commandes").Cells(k, 4)
ThisWorkbook.Sheets("Détails N-1").Cells(ThisWorkbook.Sheets("Détails N-1").Range("B" & Rows.Count).End(xlUp).Row + 1, 2) = ThisWorkbook.Sheets("Commandes").Cells(k, 2)
End If
Next k
End If
'S'il n'y a aucune données alors on arrete
If Application.CountA(ThisWorkbook.Sheets("Détails N-1").Range("A:A")) <> 0 Then
'Addition des commandes par SIRET dans la colonne C
For l = 2 To ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets("Détails N-1").Cells(l, 3) = Application.WorksheetFunction.SumIfs(ThisWorkbook.Sheets("Détails N-1").Columns(2), ThisWorkbook.Sheets("Détails N-1").Columns(1), ThisWorkbook.Sheets("Détails N-1").Cells(l, 1))
Next l
'Copie de la colonne C vers la colonne B
ThisWorkbook.Sheets("Détails N-1").Columns(2).Value = ThisWorkbook.Sheets("Détails N-1").Columns(3).Value
'Purge de la colonne C
ThisWorkbook.Sheets("Détails N-1").Columns(3).ClearContents
'Suppression des doublons
ThisWorkbook.Sheets("Détails N-1").Range("A1:B" & ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1
'Tri par quantité
ThisWorkbook.Sheets("Détails N-1").Range("A1:B" & ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=ThisWorkbook.Sheets("Détails N-1").Range("B1" & ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row), order1:=xlDescending
End If
Doevents
 
'DEUXIÈME OPÉRATION : Page Détails N
ThisWorkbook.Sheets("Détails N").Range("A:C").ClearContents
'Récupération des commandes par clients selon critères
If ThisWorkbook.Sheets("Statistiques client").Range("E2") = "Totaux" Then
For i = 1 To ThisWorkbook.Sheets("Commandes").Range("A" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Sheets("Commandes").Cells(i, 3) >= ThisWorkbook.Sheets("Statistiques").Range("C2") And ThisWorkbook.Sheets("Commandes").Cells(i, 3) <= ThisWorkbook.Sheets("Statistiques").Range("D2") Then
ThisWorkbook.Sheets("Détails N").Cells(ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = ThisWorkbook.Sheets("Commandes").Cells(i, 4)
ThisWorkbook.Sheets("Détails N").Cells(ThisWorkbook.Sheets("Détails N").Range("B" & Rows.Count).End(xlUp).Row + 1, 2) = ThisWorkbook.Sheets("Commandes").Cells(i, 2)
End If
Next i
Else
For i = 1 To ThisWorkbook.Sheets("Commandes").Range("A" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Sheets("Commandes").Cells(i, 5) = ThisWorkbook.Sheets("Statistiques client").Range("E2") And _
ThisWorkbook.Sheets("Commandes").Cells(i, 3) >= ThisWorkbook.Sheets("Statistiques").Range("C2") And ThisWorkbook.Sheets("Commandes").Cells(i, 3) <= ThisWorkbook.Sheets("Statistiques").Range("D2") Then
ThisWorkbook.Sheets("Détails N").Cells(ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = ThisWorkbook.Sheets("Commandes").Cells(i, 4)
ThisWorkbook.Sheets("Détails N").Cells(ThisWorkbook.Sheets("Détails N").Range("B" & Rows.Count).End(xlUp).Row + 1, 2) = ThisWorkbook.Sheets("Commandes").Cells(i, 2)
End If
Next i
End If
'S'il n'y a aucune données alors on arrete
If Application.CountA(ThisWorkbook.Sheets("Détails N").Range("A:A")) <> 0 Then
'Addition des commandes par SIRET dans la colonne C
For j = 2 To ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets("Détails N").Cells(j, 3) = Application.WorksheetFunction.SumIfs(ThisWorkbook.Sheets("Détails N").Columns(2), ThisWorkbook.Sheets("Détails N").Columns(1), ThisWorkbook.Sheets("Détails N").Cells(j, 1))
Next j
'Purge de la colonne B
ThisWorkbook.Sheets("Détails N").Columns(2).ClearContents
'Suppression des doublons
ThisWorkbook.Sheets("Détails N").Range("A1:C" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1
'Tri par quantité
ThisWorkbook.Sheets("Détails N").Range("A1:C" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=ThisWorkbook.Sheets("Détails N").Range("C1" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row), order1:=xlDescending
End If
Doevents
 
'TROISIÈME OPÉRATION : Récupération des quantités de Détails N en comparant le SIRET des deux pages
For m = 1 To ThisWorkbook.Sheets("Détails N-1").Range("A" & Rows.Count).End(xlUp).Row
If IsError(Application.Match(ThisWorkbook.Sheets("Détails N-1").Cells(m, 1), Sheets("Détails N").Range("A:A"), 0)) = False Then
ThisWorkbook.Sheets("Détails N-1").Cells(m, 3) = Sheets("Détails N").Cells(Application.Match(ThisWorkbook.Sheets("Détails N-1").Cells(m, 1), Sheets("Détails N").Range("A:A"), 0), 3)
Sheets("Détails N").Cells(Application.Match(ThisWorkbook.Sheets("Détails N-1").Cells(m, 1), Sheets("Détails N").Range("A:A"), 0), 3).EntireRow.ClearContents
Else
ThisWorkbook.Sheets("Détails N-1").Cells(m, 3) = 0 'Quantité à 0 si SIRET introuvable
End If
Next m
'Tri par quantité de Détails N
ThisWorkbook.Sheets("Détails N").Range("A1:C" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=ThisWorkbook.Sheets("Détails N").Range("C1" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row), order1:=xlDescending
'Mise à 0 des valeurs de la colonne B
ThisWorkbook.Sheets("Détails N").Range("B1:B" & ThisWorkbook.Sheets("Détails N").Range("A" & Rows.Count).End(xlUp).Row) = 0
Doevents
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End
End Sub

**mercatog** · 22/03/2019, 10h10

Bonjour

Essaie d'utiliser les variables tableaux. Elles offrent une rapidité notoire.

ou dans un premier temps au lieu que chaque fois tu recalcule la dernière ligne, tu le fais une seule fois via une variable que tu incrémenteras de +1

Exemple utilisant les variables tableaux

(a compléter identiquement par les parties 2 et 3)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub Details()
Dim N As Long, Nc As Long, Sta As Long, Stb As Long    'à adapter je suppose que A2 et B2 sont des dates
Dim i As Long, k As Integer
Dim Ste As String
Dim Cm, Ex()
 
Application.ScreenUpdating = False
'PREMIÈRE OPÉRATION : Page Détails N-1
With ThisWorkbook.Sheets("Détails N-1")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:C" & N).ClearContents
End With
 
'Récupération des commandes par clients selon critères
With ThisWorkbook.Sheets("Commandes")
    Nc = .Cells(.Rows.Count, 1).End(xlUp).Row
    Cm = .Range("A1:E" & Nc)
End With
 
With ThisWorkbook.Sheets("Statistiques client")
    Ste = .Range("E2").Value
    Sta = .Range("A2").Value
    Stb = .Range("B2").Value
End With
 
If Ste = "Totaux" Then
    For k = 1 To Nc
        If Cm(k, 3) >= Sta Then
            If Cm(k, 3) <= Stb Then
                i = i + 1
                ReDim Preserve Ex(1 To 2, 1 To i)
                Ex(1, i) = Cm(k, 4)
                Ex(2, i) = Cm(k, 2)
            End If
        End If
    Next k
Else
    For k = 1 To Nc
        If Cm(k, 5) = Ste Then
            If Cm(k, 3) >= Sta Then
                If Cm(k, 3) <= Stb Then
                    i = i + 1
                    ReDim Preserve Ex(1 To 2, 1 To i)
                    Ex(1, i) = Cm(k, 4)
                    Ex(2, i) = Cm(k, 2)
                End If
            End If
        End If
    Next k
End If
 
'S'il n'y a aucune données alors on arrete
If i > 0 Then
    'Addition des commandes par SIRET dans la colonne C
    With ThisWorkbook.Sheets("Détails N-1")
        .Range("A1").Resize(i, 2).Value = Application.Transpose(Ex)
        With .Range("C1").Resize(i, 2)
            .Formula = "=SUMIF($A$1:$A$" & i & ",$A1,$B$1:$B" & i & ")"
            .Offset(, -1).Value = .Value
            .ClearContents
        End With
    End With
End If
End Sub

**atk_49** · 22/03/2019, 10h31

Bonjour mercatog,

Je viens de faire un essai et le résultat est incroyable, l'opération est quasi instantanée, je suis impressionné !

Par contre je ne comprends presque rien à ton code. ^^

Je vais adapter ton exemple à mes deux autres parties, et j'aimerais poser mes questions à la suite de ce sujet pour bien comprendre le fonctionnement de ton code et les différences avec le mien, pour pouvoir m'en servir dans mes autres programmes.

Un grand merci !

**mercatog** · 22/03/2019, 10h35

La philosophie est au lieu de travailler avec les cellules (un va et vient récurent) on alimente une variable tableaux avec la totalité des cellules, on y travaille en mémoire et on réinjecte le résultat vers la feuille.

Regarde enfin le traitement de la somme.si est travaillé sur la feuille et non en mémoire

**atk_49** · 22/03/2019, 11h43

En effet, je comprends mieux pourquoi le code s’exécute plus vite.

Pour bien comprendre, j'ai essayé de "traduire" les lignes de ton code, je bute sur trois lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    For k = 1 To Nc 'Mise sous forme de variable du numéro de la dernière ligne de la feuille commande
        If Cm(k, 5) = Ste Then 'Cm est la variable du tableau ThisWorkbook.Sheets("Commandes").Range("A1:E" & Nc), le k indique la ligne de ce tableau, et le 5 sa colonne
            If Cm(k, 3) >= Sta Then
                If Cm(k, 3) <= Stb Then
                    i = i + 1 'Un compteur qui s'incrémente à chaque tour de la boucle
                    ReDim Preserve Ex(1 To 2, 1 To i) 'Je ne comprends pas cette ligne
                    Ex(1, i) = Cm(k, 4) 'Je ne comprends pas cette ligne
                    Ex(2, i) = Cm(k, 2) 'Je ne comprends pas cette ligne
                End If
            End If
        End If
    Next k

Merci

**mercatog** · 22/03/2019, 11h52

Redim Preserve: Le tableau Ex() doit être redimensionné pour chaque nouvelle "ligne". Le redimensionnement n'est possible que sur la dernière dimension. Preserve est nécessaires pour garder les données déjà contenues dans le tableau

Ex(1,i)=Cm(k,4)

On rempli la nouvelle "ligne" du tableau Ex par la la valeur de la kème ligne et 4ème colonne du tableau Cm (Commande)

Ex a été transposé par ce qu'on doit redimensionner que la dernière dimension

fais du pas à pas et tu sauras.

Je me suis amusé à revoir ton code en entier (sans garantie) et j'ai épargné une itération

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Option Explicit
 
Sub Details()
Dim N As Long, Nc As Long, Sta As Long, Stb As Long, Stc As Long, Std As Long
Dim i As Long, j As Long, k As Integer
Dim Ste As String
Dim Cm, Ex(), Ac()
Dim T As Byte
Dim Mtx
 
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Détails N-1")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:C" & N).ClearContents
End With
With ThisWorkbook.Sheets("Détails N")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:C" & N).ClearContents
End With
 
With ThisWorkbook.Sheets("Commandes")
    Nc = .Cells(.Rows.Count, 1).End(xlUp).Row
    Cm = .Range("A1:E" & Nc)
End With
 
With ThisWorkbook.Sheets("Statistiques client")
    Ste = .Range("E2").Value
    Sta = .Range("A2").Value
    Stb = .Range("B2").Value
    Stc = .Range("C2").Value
    Std = .Range("D2").Value
End With
 
If Ste = "Totaux" Then
    For k = 1 To Nc
        If Cm(k, 3) >= Sta Then
            If Cm(k, 3) <= Stb Then
                i = i + 1
                ReDim Preserve Ex(1 To 3, 1 To i)
                Ex(1, i) = Cm(k, 4)
                Ex(2, i) = Cm(k, 2)
            End If
        End If
 
        If Cm(k, 3) >= Stc Then
            If Cm(k, 3) <= Std Then
                j = j + 1
                ReDim Preserve Ac(1 To 3, 1 To i)
                Ac(1, j) = Cm(k, 4)
                Ac(2, j) = Cm(k, 2)
            End If
        End If
    Next k
Else
    For k = 1 To Nc
        If Cm(k, 5) = Ste Then
            If Cm(k, 3) >= Sta Then
                If Cm(k, 3) <= Stb Then
                    i = i + 1
                    ReDim Preserve Ex(1 To 3, 1 To i)
                    Ex(1, i) = Cm(k, 4)
                    Ex(2, i) = Cm(k, 2)
                End If
            End If
        End If
        If Cm(k, 5) = Ste Then
            If Cm(k, 3) >= Stc Then
                If Cm(k, 3) <= Std Then
                    j = j + 1
                    ReDim Preserve Ac(1 To 3, 1 To i)
                    Ac(1, j) = Cm(k, 4)
                    Ac(2, j) = Cm(k, 2)
                End If
            End If
        End If
    Next k
End If
 
If i > 0 Then
    With ThisWorkbook.Sheets("Détails N-1")
        .Range("A1").Resize(i, 3).Value = Application.Transpose(Ex)
        With .Range("C1").Resize(i, 2)
            .Formula = "=SUMIF($A$1:$A$" & i & ",$A1,$B$1:$B" & i & ")"
            .Offset(, -1).Value = .Value
            .ClearContents
        End With
        .Range("A1").Resize(j, 2).RemoveDuplicates Columns:=1
        .Range("A1").Resize(j, 2).Sort key1:=.Range("C1"), order1:=xlDescending
    End With
End If
 
If j > 0 Then
    With ThisWorkbook.Sheets("Détails N")
        .Range("A1").Resize(j, 3).Value = Application.Transpose(Ac)
        With .Range("C1").Resize(j, 2)
            .Formula = "=SUMIF($A$1:$A$" & j & ",$A1,$B$1:$B" & j & ")"
            .Value = .Value
            .Offset(, -1).ClearContents
        End With
        .Range("A1").Resize(j, 2).RemoveDuplicates Columns:=1
        .Range("A1").Resize(j, 2).Sort key1:=.Range("C1"), order1:=xlDescending
    End With
End If
 
'TROISIÈME OPÉRATION : Récupération des quantités de Détails N en comparant le SIRET des deux pages
For k = 1 To i
    Mtx = Application.Match(Ex(k, 1), Sheets("Détails N").Range("A:A"), 0)
    If IsError(Mtx) Then
        Ex(k, 3) = 0    'Quantité à 0 si SIRET introuvable
    Else
        Ex(k, 3) = Ac(Mtx, 3)
        For T = 1 To 3
            Ac(Mtx, T) = ""
        Next T
    End If
Next k
 
With ThisWorkbook.Sheets("Détails N")
    .UsedRange.ClearContents
    .Range("A1").Resize(j, 3).Value = Application.Transpose(Ac)
    .Range("A1").Resize(j, 3).Sort key1:=.Range("C1"), order1:=xlDescending
End With
 
With ThisWorkbook.Sheets("Détails N-1")
    .UsedRange.ClearContents
    .Range("A1").Resize(UBound(Ex, 2), 3).Value = Application.Transpose(Ex)
End With
End Sub

Lenteur d’exécution du code [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager