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

**atk_49** · 25/03/2019, 15h33

Après m'être en partie arraché les cheveux, je pense avoir compris les grandes lignes de la méthode, et elle est vraiment efficace !

Je me suis grandement inspiré de ton code que j'ai du (un tout petit peu) modifier pour qu'il corresponde avec quelques particularités de mon fichier que je n'avais pas précisé.
Pour info, j'ai aussi potassé ce tuto qui m'a été d'une grande aide.

Mais tu m'as clairement permis de faire un grand pas dans mes connaissance en VBA Excel, donc merci beaucoup !

Bonne journée

**MarcelG** · 25/03/2019, 15h55

Salut,

Pour compléter l'excellent code de mercatog, voici de la documentation
Les tableaux par Silkyroad

Tu peux aussi consulter l'espace de Jacques Boisgontier consacré aux tableaux.

Attention, on devient vite "addict"!

**atk_49** · 26/03/2019, 08h35

Merci Marcel G,

A tout hasard, peut-on utiliser les variables tableaux avec la méthode d'import de données ADO ?

Exemple de code :

Code :

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

1
2
3
4
5
6
7
8
9
10
rst.Open "SELECT CodeDocument, CodeArticle, Quantite, CodeTiers, DateDocument FROM LigneCdeClient WHERE LigneCdeClient.Quantite > 0 And LigneCdeClient.CodeArticle <> '' And LEFT(LigneCdeClient.CodeArticle, 1) LIKE '[0-9]%' ORDER BY LigneCdeClient.CodeDocument", cnx
While Not (rst.EOF)
    ThisWorkbook.Sheets("Commandes").Cells(Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Commandes").Range("A:A")) + 1, 1) = rst.Fields("CodeArticle")
    ThisWorkbook.Sheets("Commandes").Cells(Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Commandes").Range("B:B")) + 1, 2) = rst.Fields("Quantite")
    ThisWorkbook.Sheets("Commandes").Cells(Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Commandes").Range("C:C")) + 1, 3) = rst.Fields("DateDocument")
    ThisWorkbook.Sheets("Commandes").Cells(Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Commandes").Range("D:D")) + 1, 4) = rst.Fields("CodeTiers")
rst.MoveNext
Wend
rst.Close
cnx.Close

Merci

**MarcelG** · 26/03/2019, 08h53

Bonjour Atk, Bonjour le Forum,

A tout hasard, peut-on utiliser les variables tableaux avec la méthode d'import de données ADO ?

Là, je dis "Joker".
Formulaires, Dictionnaires, Tableaux, Oui peut-être.
API, ADO,.... Non sûrement

**mercatog** · 26/03/2019, 12h38

Bonjour le forum. Marcel

Tu cherche la dernière cellule remplie. Une seul fois
Tu fais une rst.copyfromrecirdset de la cellule d'en dessous.

Code :

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

1
2
3
With worksheets("ta feuille")
    .cells(.rows.count,1).end(xlup)(2)=rst.copyfromrecordset
End with

Ecrit vite fait

La disposition des champs de la requête et des colonnes doite être identique.

**atk_49** · 27/03/2019, 11h41

Bonjour,

Merci Mercatog, finalement j'utilise cette méthode :

Code :

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

1
2
3
rst.Open "SELECT CodeArticle, Quantite, DateDocument, CodeTiers FROM LigneCdeClient WHERE LigneCdeClient.Quantite > 0 And LigneCdeClient.CodeArticle <> '' And LEFT(LigneCdeClient.CodeArticle, 1) LIKE '[0-9]%' ORDER BY LigneCdeClient.DateDocument", cnx
ThisWorkbook.Sheets("Commandes").Range("A1").CopyFromRecordset rst
rst.Close

Une autre question au sujet des variables tableau, le code ci-dessous fonctionne bien mais lorsque que je récupère les données provenant du Tableau2, la dernière ligne contient #N/A, saurais-tu pourquoi ?
Au passage, ton avis sur ce code est le bienvenue

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
Dim i As Integer, j As Integer
Dim Lignes_Tableau1 As Long
Dim Tableau1, Tableau2()
Lignes_Tableau1 = ThisWorkbook.Sheets("Commandes").Range("A" & Rows.Count).End(xlUp).Row
Tableau1 = ThisWorkbook.Sheets("Commandes").Range("A1:D" & Lignes_Tableau1)

On Error Resume Next
ReDim Tableau2(1 to 3, 1 To Lignes_Tableau1)
For i = 1 To Lignes_Tableau1
	Tableau2(1, i) = Sheets("Articles").Cells(Application.Match(Tableau1(i, 1), Sheets("Articles").Range("A:A"), 0), 2) 'Récupération des gammes standard
	Tableau2(2, i) = Sheets("Accrochages composés").Cells(Application.Match(Left(Tableau1(i, 1), 5), Sheets("Accrochages composés").Range("A:A"), 0), 2) 'Récupération des gammes composés
		For j = 1 To 6
			If Tableau2(2, i) = vbNullString Then Tableau2(2, i) = Sheets("Gammes").Cells(Application.Match(Tableau2(1, i), Sheets("Gammes").Columns(j), 0), 1) 'Simplification des gammes
		Next j
	If Tableau2(2, i) <> vbNullString Then Tableau2(3, i) = Sheets("Clients").Cells(Application.Match(Tableau1(i, 4), Sheets("Clients").Range("A:A"), 0), 3) 'Récupération des SIRET Clients
	If Tableau2(3, i) = vbNullString Then ThisWorkbook.Sheets("Commandes").Cells(i, 1).EntireRow.ClearContents 'Suppression des lignes dont le SIRET est vide
Next i
ThisWorkbook.Sheets("Commandes").Range("E1").Resize(i, 1).Value = Application.Transpose(Application.Index(Tableau2, 2)) 'Récupération de la deuxième dimension du Tableau2
ThisWorkbook.Sheets("Commandes").Range("D1").Resize(i, 1).Value = Application.Transpose(Application.Index(Tableau2, 3)) 'Récupération de la troisième dimension du Tableau2
ThisWorkbook.Sheets("Commandes").Rows(Lignes_Tableau1 + 1).ClearContents

Merci d'avance

**mercatog** · 27/03/2019, 12h48

.Resize(i-1,....

Je n' ai pas le temps de voir tout

**atk_49** · 27/03/2019, 15h19

Merci mercatog, en effet le problème venait bien de cette ligne que j'ai remplacé par :

Code :

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

ThisWorkbook.Sheets("Commandes").Range("D1:D" & Lignes_Tableau1).Value = Application.Transpose(Application.Index(Tableau2, 3))

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

Macros et VBA Excel

Discussions similaires

Partager

Partager