Temps d'exécution macro s'allonge avec le temps

Bonjour,

Désolé pour le titre de ce post, je ne savais pas trop quoi mettre pour me faire comprendre et je ne me sens pas l'âme du pouët ce matin ;)
Je viens de terminer la conception d'une macro de mise en forme de données - j'en profite au passage pour remercier toutes les personnes qui ont eu la patience et la gentillesse de m'aider (mercatog, MarcelG, rvtoulon, Godzestla et j'en oublie...) à concevoir cette macro - et à l'exécution de celle-ci, je remarque que si je la lance plusieurs fois d'affilée sans sauvegarder / fermer le fichier entre chaque exécution, la macro est de plus en plus longue à s'exécuter jusqu'au bout. Pour info, j'ai bien écrit :

Code:

Application.ScreenUpdating = False

au début. Il y a beaucoup de ce code qui copie / colle des données d'onglets sur des autres, cela peut-il venir de là ? Avez-vous une idée de ce qui peut provoquer un ralentissement dans le temps de la macro, sachant que je l'exécute avec les mêmes données bien entendu... ?
Merci !

Bonjour

Sans ta macro cela ne va pas être facile pour avoir une réponse.

Philippe

Bonsoir,
C'est peut-être le presse-papier qui s'engorge. Essaies de le vider manuellement entre chaque exécution de ta macro.
Je rejoins Philippe, ce serait plus facile avec la macro.

@+

Bonjour,

En effet, avec le code ça sera plus simple. Je vous mets la totalité de ce dernier. Bon, elle n'est pas violente, c'est une de mes premières macros...

Code:

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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
Sub Build_ADN_FR()
 
' Compiler les données pour LCEFR
 
Application.ScreenUpdating = False
 
    'Nettoyer fichier
 
    Sheets("Retreated AX data").UsedRange.ClearContents
    Sheets("Retreated Infoview data").UsedRange.ClearContents
    Sheets("Dataloader").UsedRange.ClearContents
 
    'Copier / coller les données AX de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original AX data")
 
    .Range("A1:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Sheets("Retreated AX data").Range("B1")
    End With
 
 
    'Indiquer le numéro de compte sur chaque ligne
 
    With Sheets("Retreated AX data")
 
        Dim LR1 As Long
        LR1 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
            With .Range("A2:A" & LR1)
            .Formula = "=IF(RC[1] =""CPT"", RC[2], R[-1]C)"
            .Value = .Value
            End With
 
    'Supprimer lignes inutiles
 
        .Range("F1:F" & LR1).AutoFilter Field:=1, Criteria1:="Devise", Criteria2:="=", Operator:=xlOr
        If .Range("F1:F" & LR1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("F2:F" & LR1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
        .AutoFilterMode = False
 
    'MEF colonne des activités (SUPPRESPACE)
 
        Dim LR2 As Long
        LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        .Range("C1").EntireColumn.Insert
 
            With .Range("C2:C" & LR2)
            .Formula = "=TRIM(RC[1])"
            .Value = .Value
            End With
 
        .Range("D1").EntireColumn.Delete
 
    'Renommer les noms de champ
 
        .Range("A1:J1") = Array("Compte", "Date", "Activité", "N°document", "Libellé", "Devise", "Montant en devise", "Montant", "Cumul", "Résultat")
 
    'Calcul du résultat
 
        Dim RAX As String
 
        .Range("J2:J" & LR2).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-2],"""")"
        RAX = Format(WorksheetFunction.Sum(.Range("J2:J" & LR2)), "#,##.00")
        MsgBox "Source AX: Le résultat de la période est de " & RAX & " €", vbOKOnly, "Calcul du résultat"
 
    End With
 
    'Copier / coller les données Infoview de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original Infoview data")
 
        Dim Matrix As Range, MStart As Range
        Set MStart = .UsedRange.Find("Account Number", LookIn:=xlValues)
            If Not MStart Is Nothing Then
        Set Matrix = .Range(MStart, MStart.End(xlToRight).End(xlDown))
        Matrix.Copy Sheets("Retreated Infoview data").Range("A1")
            End If
        Set MStart = Nothing
        Set Matrix = Nothing
 
    End With
 
    'Calcul du résultat Infoview
 
    With Sheets("Retreated Infoview data")
 
        Dim LR3 As Long, RI As String
        LR3 = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        .Range("J2:J" & LR3).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-1],"""")"
        RI = Format(WorksheetFunction.Sum(.Range("J2:J" & LR3)), "#,##.00")
        MsgBox "Source Infoview: Le résultat de la période est de " & RI & " €", vbOKOnly, "Calcul du résultat"
 
    'Calcul de l'écart entre résultats AX & Infoview
 
        Dim Disc As String, Question As Integer
        Disc = Format(Round(CDbl(RAX - RI), 2), "#,##0.00")
        Question = MsgBox("La différence entre le résultat d'AX et d'Infoview est de " & Disc & " est-ce correct ?", vbYesNo + vbQuestion, "Calcul de l'écart de résultat")
        If Question = vbNo Then
            MsgBox "Erreur dans l'intégration des fichiers, veuillez recommencer la procédure depuis le début", vbCritical, "Erreur"
            End
        Else
            MsgBox "Continuer", vbOKOnly + vbInformation, "Compilation des données"
        End If
 
    End With
 
    'Compiler données finales
 
    'Copier BS
 
    With Sheets("Retreated Infoview data")
 
    .Range("J1:J" & LR3).AutoFilter Field:=1, Criteria1:="="
        If .Range("A1:A" & LR3).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("A2:A" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B2")
            .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E2")
            .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("F2")
        End If
    .AutoFilterMode = False
 
    End With
 
    With Sheets("Dataloader")
 
    Dim BSE As Long, PNLS As Long
    BSE = .Cells(.Rows.Count, 2).End(xlUp).Row
    PNLS = BSE + 1
 
    End With
 
    'Copier PNL
 
    With Sheets("Retreated AX data")
 
    .Range("J1:J" & LR2).AutoFilter Field:=1, Criteria1:="<>"
    If .Range("A1:A" & LR2).SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Range("A2:A" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B" & PNLS)
        .Range("C2:C" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("D" & PNLS)
        .Range("H2:H" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E" & PNLS)
        .Range("H2:H" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("F" & PNLS)
        .Range("B2:B" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("G" & PNLS)
        .Range("E2:E" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("H" & PNLS)
        .Range("D2:D" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("I" & PNLS)
    End If
    .AutoFilterMode = False
 
    End With
 
    'Définir entité
 
    With Sheets("Dataloader")
    Dim PNLE As Long
    PNLE = .Cells(.Rows.Count, 2).End(xlUp).Row
 
    .Range("A2:A" & PNLE) = "LCEFR"
 
    'Définir type de compte
 
    Dim AccType As Range
 
    For Each AccType In .Range("C2:C" & BSE)
        If AccType.Offset(0, 2).Value < 0 Then
            AccType.Value = "C"
        Else
            AccType.Value = "D"
        End If
    Next AccType
 
    .Range("C" & PNLS & ":C" & PNLE) = "R"
 
    'Définir activité (BS)
 
    .Range("D2:D" & BSE) = "LCFG"
 
    'Date
 
    Dim ClosureDay As Date
    ClosureDay = InputBox("Entrez le dernier jour du mois clôturé (Format = jj/mm/aaaa)", "Définition de la date")
    .Range("G2:G" & BSE) = ClosureDay
 
    'Définir données
 
    .Range("J2:J" & PNLE) = "SOCIAL"
 
    'Supprimer lignes sans montant ou avec montant nul
 
    .Range("E1:E" & PNLE).AutoFilter Field:=1, Criteria1:="=", Criteria2:="=0"
        If .Range("E1:E" & PNLE).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("E2:E" & PNLE).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
    .AutoFilterMode = False
 
    'Définir en-têtes
 
    .Range("A1:J1") = Array("Entité", "Compte", "D-C-R", "Activité", "Montant en devise locale", "Montant en €", "Date", "Libellé", "Pièce", "Données")
 
    'MEF compte
 
    Dim PNLE2 As Long, k As Byte, Account As Range
    PNLE2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    k = 1
 
    For Each Account In .Range("B2:B" & PNLE2)
    Account.Value = Account.Value * k
        With Account.NumberFormat = General
        End With
    Next Account
 
    'Contrôle final du fichier
 
    Dim Disc2 As String, Question2 As Integer
    Disc2 = Format(WorksheetFunction.Sum(.Range("E2:E" & PNLE2)), "#,##0.00")
    Question2 = MsgBox("La somme de la balance et du compte de résultat est de " & Disc2 & " est-ce correct ?", vbYesNo + vbQuestion, "Calcul de la somme des montants en devise locale")
    If Question2 = vbNo Then
        MsgBox "Erreur dans la compilation des données, veuillez recommencer la procédure depuis le début", vbCritical, "Erreur"
        End
    Else
        MsgBox "Compilation du fichier ADN pour LCE FR terminée", vbOKOnly + vbExclamation, "Fin de la procédure"
    End If
 
    End With
 
Application.ScreenUpdating = True
 
End Sub

Pour vider le presse paier, c'est un truc du genre CutCopyMode ou quelque chose dans le genre non ? Je vais commencer à fouiller sur le forum.
Merci d'avance pour votre aide !

Bonjour,
Pour le presse-papier, je pensais déjà commencer par le vider manuellement avant chaque lancement de ta macro pour tester si ça a une influence.
Je n'ai pas encore regardé le code.

@+

Bonjour,

Désolé pour ma réponse tardive, pas eu / pris le temps de tester plus tôt En vidant le presse-papier manuellement, cela semble plus efficace en effet. Merci pour ta réponse, je n'ai plus qu'à l'intégrer dans mon code maintenant.