Un code trop lent à s'exécuter

**djibysadji** · 29/03/2024, 15h11

Bonjour, le forum!
Le code ci-dessous fonctionne, mais prend trop de temps à s'exécuter. Y a-t-il un moyen de réduire le temps d'exécution de cette macro? Comment?

Merci par avance

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
Private Sub CmdValider_Click()
Dim choix As String
 
choix = vbYes
If MsgBox("Voulez-vous enregistrer cette opération?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
 
Dim derligne As Integer
Dim WS As Worksheet
Dim ligne As Integer
 
Set WS = Sheets("Journaux")
derligne = WS.Range("B5000").End(xlUp).Row
If WS.Range("B5").Value = "" Then
derligne = WS.Range("B5000").End(xlUp).Row
Else
derligne = WS.Range("B5000").End(xlUp).Row + 1
End If
 
For ligne = 19 To 40
If Cells(ligne, 3).Value <> "" Then
WS.Range("B" & derligne).Value = Range("G15").Value
WS.Range("C" & derligne).Value = Range("G13").Value
WS.Range("D" & derligne).Value = Range("D13").Value
WS.Range("E" & derligne).Value = Cells(ligne, 3).Value
WS.Range("F" & derligne).Value = Cells(ligne, 4).Value
WS.Range("G" & derligne).Value = Cells(ligne, 5).Value
WS.Range("H" & derligne).Value = Cells(ligne, 6).Value
WS.Range("I" & derligne).Value = Range("D15").Value
WS.Range("J" & derligne).Value = Cells(ligne, 7).Value
WS.Range("K" & derligne).Value = Cells(ligne, 8).Value
 
derligne = derligne + 1
 
End If
Next
Range("G15").Value = Range("G15").Value + 1
Range("G15").Value = ""
Range("G13").Value = ""
Range("D13").Value = ""
Range("D15").Value = ""
Range("E19").Value = ""
Range("E20").Value = ""
Range("E21").Value = ""
Range("E22").Value = ""
Range("F19").Value = ""
Range("F20").Value = ""
Range("F21").Value = ""
Range("F22").Value = ""
Range("G19").Value = ""
Range("G20").Value = ""
Range("G21").Value = ""
Range("G22").Value = ""
Range("H19").Value = ""
Range("H20").Value = ""
Range("H21").Value = ""
Range("H22").Value = ""
 
Sheets("Saisie").Range("C19:C40").ClearContents
Sheets("Saisie").Range("E19:E40").ClearContents
Sheets("Saisie").Range("F19:F40").ClearContents
Sheets("Saisie").Range("G19:G40").ClearContents
Sheets("Saisie").Range("H19:H40").ClearContents
 
End If
End Sub

**ARTURO83** · 31/03/2024, 07h32

Bonjour,

Ajoutez la ligne suivante au-dessus de "Choix=vbYes"

Code :

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

 Application.ScreenUpdating = False

Cdlt

**djibysadji** · 31/03/2024, 18h20

Envoyé par ARTURO83

Bonjour,

Ajoutez la ligne suivante au-dessus de "Choix=vbYes"

Code :

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

 Application.ScreenUpdating = False

Cdlt

Salut,
J'ai essayé mais ça ne résout pas le problème.

**Nain porte koi** · 31/03/2024, 19h21

Hello,

vous pouvez nous donner un fichier d'exemples (sans données confidentielles) ?

**BENNASR** · 01/04/2024, 10h15

bonjour
je crois qu'il y a d'autres procédures qui ralentissent l'exécution du code
toutefois et pour déterminer la dernière ligne non vide je recommande ce-ci :

Code :

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

1
2
3
4
5
6
Set ws = Sheets("Journaux")
If ws.Range("B5").Value = "" Then
derligne = ws.Range("A" & Rows.Count).End(xlUp).Row
Else
derligne = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
End If

il y a une ligne je crois inutile ds votre code avant le if : derligne = WS.Range("B5000").End(xlUp).Row
aussi tu peux vider les cellule en une seule ligne :

Code :

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

ws.Range("G15,D13,D15,E19,E20,E22").ClearContents

au lieu de

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
Range("G15").Value = ""
Range("G13").Value = ""
Range("D13").Value = ""
Range("D15").Value = ""
Range("E19").Value = ""
Range("E20").Value = ""
Range("E21").Value = ""
Range("E22").Value = ""
Range("F19").Value = ""
Range("F20").Value = ""
Range("F21").Value = ""
Range("F22").Value = ""
Range("G19").Value = ""
Range("G20").Value = ""
Range("G21").Value = ""
Range("G22").Value = ""
Range("H19").Value = ""
Range("H20").Value = ""
Range("H21").Value = ""
Range("H22").Value = ""

**djibysadji** · 01/04/2024, 16h41

Envoyé par BENNASR

bonjour
je crois qu'il y a d'autres procédures qui ralentissent l'exécution du code
toutefois et pour déterminer la dernière ligne non vide je recommande ce-ci :

Code :

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

1
2
3
4
5
6
Set ws = Sheets("Journaux")
If ws.Range("B5").Value = "" Then
derligne = ws.Range("A" & Rows.Count).End(xlUp).Row
Else
derligne = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
End If

il y a une ligne je crois inutile ds votre code avant le if : derligne = WS.Range("B5000").End(xlUp).Row
aussi tu peux vider les cellule en une seule ligne :

Code :

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

ws.Range("G15,D13,D15,E19,E20,E22").ClearContents

au lieu de

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
Range("G15").Value = ""
Range("G13").Value = ""
Range("D13").Value = ""
Range("D15").Value = ""
Range("E19").Value = ""
Range("E20").Value = ""
Range("E21").Value = ""
Range("E22").Value = ""
Range("F19").Value = ""
Range("F20").Value = ""
Range("F21").Value = ""
Range("F22").Value = ""
Range("G19").Value = ""
Range("G20").Value = ""
Range("G21").Value = ""
Range("G22").Value = ""
Range("H19").Value = ""
Range("H20").Value = ""
Range("H21").Value = ""
Range("H22").Value = ""

Bonjour
J'ai essayé vos suggestions mais le problème reste entier.
J'ai tenté de joindre une pièces mais ça ne passe pas.

**Jean-Philippe André** · 01/04/2024, 20h00

Salut,

quand tu dis trop de temps à s'exécuter, tu parles de quelle durée ? et tu espères l'accélérer jusqu'à quel point ?

Tu n'es sensé avoir qu'un maximum de 22 occurrences (For ligne = 19 To 40), donc ce n'est pas sensé être long.
Peux tu nous en dire plus stp ?

As-tu des formules qui se rafraichissent ?

**Valtrase** · 03/04/2024, 11h17

Bonjour,
Et en complément de tout ce qui a été dit précédemment

La variable choix doit-être de type VbMsgBoxResult et non pas String (éventuellement de type Long)
choix = vbyes est inutile et doit être supprimer
Comme vous avez affecté la feuille cible avec WS vous devez affecter la feuille source. Range("G15").Value se réfère à la feuille active, mais il vaut mieux que cela soit explicite.
Vérifier qu'aucun code n'est exécuté dans les évènements Worksheet_SelectionChange et Worksheet_Change de la feuille cible sinon désactivez les évènements en tête de procédure CmdValider_Click.
Les variables derligne et ligne doivent être de type long. (Préférable avec les nouveaux processeurs)
Si les lignes 19 à 40 font parties du détail d'une facture par exemple et serait peu-être plus judicieux de les transformées en tableau.

Un fichier serait peut-être le bienvenu.

**djibysadji** · 03/04/2024, 19h43

Envoyé par Jean-Philippe André

Salut,

quand tu dis trop de temps à s'exécuter, tu parles de quelle durée ? et tu espères l'accélérer jusqu'à quel point ?

Tu n'es sensé avoir qu'un maximum de 22 occurrences (For ligne = 19 To 40), donc ce n'est pas sensé être long.
Peux tu nous en dire plus stp ?

As-tu des formules qui se rafraichissent ?

Oui effectivement j'ai des formules qui se rafraichissent.

**Nain porte koi** · 03/04/2024, 23h29

Envoyé par djibysadji

Oui effectivement j'ai des formules qui se rafraichissent.

Code :

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

1
2
3
4
5
6
7
8
Private Sub CmdValider_Click()
Application.Calculation = xlManual
...
...
...
Calculate
Application.Calculation = xlAutomatic
End Sub

**djibysadji** · 04/04/2024, 00h55

Envoyé par Nain porte koi

Code :

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

1
2
3
4
5
6
7
8
Private Sub CmdValider_Click()
Application.Calculation = xlManual
...
...
...
Calculate
Application.Calculation = xlAutomatic
End Sub

Bonsoir
Merci. Cela va nettement mieux.

Un code trop lent à s'exécuter [XL-MAC 2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager