Améliorer vitesse d'éxecution Macro

Version imprimable

Bonjour à tous, :)

Je post ce message car j'ai essayé pas mal de choses pour rendre ma macro plus rapide (Mettre à Off tout ce qui peut être mis à Off...) mais rien n'y fait elle met beaucoup de temps (trop!) :?

Si quelqu'un aurait du temps pour m'aider à déconstruire ce code qui pourtant n'est pas très compliqué, je lui en serai mille fois reconnaissant !!!

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
Private Sub CommandButton1_Click()
 
Dim DLig As Long, i As Long, DernLigne As Long ' Declare la variable Dlig, Long, DernLigne
Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
Dim iCalcul As Integer
 
Application.ScreenUpdating = False 'Empeche le rafraichissement de l'écran
 
DLig = Sheets("EXTRACT").Range("AH" & Rows.Count).End(xlUp).Row ' Recherche la Dernière Ligne de la Colonne AH pour compter les lignes'
For i = DLig To 2 Step -1 ' Boucle sur les lignes de la Dernière trouvée a la ligne n°2
 
 
'Factures déjà payées'
    If CheckBox1 = True And Cells(i, 34) = "Totalement Payée" Then Rows(i).EntireRow.delete 'Vient supprimer les lignes qui ont été totalement payées'
 
'Code nature'
    If CheckBox2 = True And Cells(i, 15) = "NCAEHHG" Then Rows(i).EntireRow.delete ' Vient supprimer les lignes avec code nature NCAEHHG (qui correspondent aux échanges)'
 
'BU'
    If CheckBox3 = True And Cells(i, 18) = "ELEMENT NEUTRE" Then Rows(i).EntireRow.delete 'Supprime les lignes elements neutre'
    If CheckBox5 = True And Cells(i, 18) = "ACHETEZ FACILE" Then Rows(i).EntireRow.delete 'Supprime les lignes ACF'
    If CheckBox4 = True And Cells(i, 18) = "REGIE PUBLICITAIRE WEB" Then Rows(i).EntireRow.delete 'Supprime les lignes de régie publicitaire'
 
'Supprimer les lignes à 0€ '
    If Cells(i, 25) = 0 Then Rows(i).EntireRow.delete
 
'suppression des lignes dont la date d'échéance est passée
   Range("G1").Select
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveSheet.Range("$A$1:$AI$274").AutoFilter Field:=7, Criteria1:= _
        ">22/08/2016", Operator:=xlAnd
    ActiveWindow.SmallScroll Down:=-21
    Range("A275").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.delete Shift:=xlUp
 
'Remplacer les points par des virgules'
    Cells(i, 24) = Replace(Cells(i, 24).Value, ".", ",")
    Cells(i, 25) = Replace(Cells(i, 25).Value, ".", ",")
    Cells(i, 26) = Replace(Cells(i, 26).Value, ".", ",")
    Cells(i, 28) = Replace(Cells(i, 28).Value, ".", ",")
    Cells(i, 31) = Replace(Cells(i, 31).Value, ".", ",")
    Cells(i, 32) = Replace(Cells(i, 32).Value, ".", ",")
 
'Modification police date et monétaire'
    Cells(i, 24).Style = "currency"
    Cells(i, 25).Style = "currency"
    Cells(i, 26).Style = "currency"
    Cells(i, 31).Style = "currency"
    Cells(i, 32).Style = "currency"
 
    Cells(i, 5).NumberFormat = "dd/mm/yyyy"
    Cells(i, 6).NumberFormat = "dd/mm/yyyy"
    Cells(i, 7).NumberFormat = "dd/mm/yyyy"
    Cells(i, 29).NumberFormat = "dd/mm/yyyy"
    Cells(i, 30).NumberFormat = "dd/mm/yyyy"
 
Next i 'Prochaine Ligne
 
End Sub

Je remercie d'avance celles et ceux qui prendront le temps de me venir en aide ! :)

arochab

22/08/2016, 13h02
Jean-Philippe André

Salut,

tes checkbox peuvent elles etre toutes cochees ou non ?

Bonjour,
Déjà : c'est quoi, tous ces scrollcolumn successifs ? (seul le dernier sera appliqué !)
Et c'est quoi, ces succession de sélection
Code:

1 2 3 4 5 6 Range("A275").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select
dont la seule applicable sera la dernière ?
Ne travaille pas sur des select, mais directement sur les objets Excel

Hello et merci pour votre aide,

jpcheck, effectivement elles peuvent toutes l'être

unparia, ma macro ayant été enregistrée en grande partie et non codée, j'imagine que ça doit être pour cela qu'il y'a autant de scrollcolumn successifs. Que me conseillerais-tu de faire ? En gardant seulement la dernière tu peux me confirmer que les autres colonnes seront toujours traitées ?

Merci à nouveau :)

Du coup mon nouveau code, sans les scrollcolumn et les selects serait celui ci

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
Private Sub CommandButton1_Click()
 
Dim DLig As Long, i As Long, DernLigne As Long ' Declare la variable Dlig, Long, DernLigne
Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
Dim iCalcul As Integer
 
 
 
Application.ScreenUpdating = False 'Empeche le rafraichissement de l'écran
 
 
 
 
 
DLig = Sheets("EXTRACT").Range("AH" & Rows.Count).End(xlUp).Row ' Recherche la Dernière Ligne de la Colonne AH pour compter les lignes'
For i = DLig To 2 Step -1 ' Boucle sur les lignes de la Dernière trouvée a la ligne n°2
 
 
'Factures déjà payées'
    If CheckBox1 = True And Cells(i, 34) = "Totalement Payée" Then Rows(i).EntireRow.delete 'Vient supprimer les lignes qui ont été totalement payées'
 
'Code nature'
    If CheckBox2 = True And Cells(i, 15) = "NCAEHHG" Then Rows(i).EntireRow.delete ' Vient supprimer les lignes avec code nature NCAEHHG (qui correspondent aux échanges)'
 
'BU'
    If CheckBox3 = True And Cells(i, 18) = "ELEMENT NEUTRE" Then Rows(i).EntireRow.delete 'Supprime les lignes elements neutre'
    If CheckBox5 = True And Cells(i, 18) = "ACHETEZ FACILE" Then Rows(i).EntireRow.delete 'Supprime les lignes ACF'
    If CheckBox4 = True And Cells(i, 18) = "REGIE PUBLICITAIRE WEB" Then Rows(i).EntireRow.delete 'Supprime les lignes de régie publicitaire'
 
'Supprimer les lignes à 0€ '
    If Cells(i, 25) = 0 Then Rows(i).EntireRow.delete
 
'suppression des lignes dont la date d'échéance est passée
   Range("G1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AI$274").AutoFilter Field:=7, Criteria1:= _
        ">22/08/2016", Operator:=xlAnd
    ActiveWindow.SmallScroll Down:=-21
    Range("A275").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.delete Shift:=xlUp
 
 
 
 
'Remplacer les points par des virgules'
    Cells(i, 24) = Replace(Cells(i, 24).Value, ".", ",")
    Cells(i, 25) = Replace(Cells(i, 25).Value, ".", ",")
    Cells(i, 26) = Replace(Cells(i, 26).Value, ".", ",")
    Cells(i, 28) = Replace(Cells(i, 28).Value, ".", ",")
    Cells(i, 31) = Replace(Cells(i, 31).Value, ".", ",")
    Cells(i, 32) = Replace(Cells(i, 32).Value, ".", ",")
 
'Modification police date et monétaire'
    Cells(i, 24).Style = "currency"
    Cells(i, 25).Style = "currency"
    Cells(i, 26).Style = "currency"
    Cells(i, 31).Style = "currency"
    Cells(i, 32).Style = "currency"
 
    Cells(i, 5).NumberFormat = "dd/mm/yyyy"
    Cells(i, 6).NumberFormat = "dd/mm/yyyy"
    Cells(i, 7).NumberFormat = "dd/mm/yyyy"
    Cells(i, 29).NumberFormat = "dd/mm/yyyy"
    Cells(i, 30).NumberFormat = "dd/mm/yyyy"
 
 
Next i 'Prochaine Ligne
 
 
End Sub

Mais elle reste quand même bien lente...

Merci !

arochab

22/08/2016, 13h24
Jean-Philippe André

Quelques pistes a envisager :
- une fois la suppression de la ligne, inutile d’exécuter le reste => passer a l'iteration suivante
- ton replace et ton style= currency, tu les fais une fois pour toute apres tes boucles, pas la peine de te le taper pour toutes les lignes une a une
22/08/2016, 13h30
arochab

Niquel merci jpcheck,

Du coup une fois la ligne supprimée, je devrais faire un Continue For, un For...Next ... ?
Pour Style et Currency, je ne vois pas comment les faire une fois pour toute... :s

Merci beaucoup

arochab

Bonjour,

Code:

1
2
3
 
'Supprimer les lignes à 0€ '
    If Cells(i, 25) = 0 Then Rows(i).EntireRow.delete

Plutot que supprimmer ligne par ligne, passer par un filtre avancé te ferais gagné du temps.
Un tuto:http://philippetulliez.developpez.co...dvancedfilter/

D'ailleurs en parlant de filtre

Code:

1
2
3
4
5
6
7
8
9
10
 
'suppression des lignes dont la date d'échéance est passée
   Range("G1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AI$274").AutoFilter Field:=7, Criteria1:= _
        ">22/08/2016", Operator:=xlAnd
    ActiveWindow.SmallScroll Down:=-21
    Range("A275").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.delete Shift:=xlUp

Pourquoi est il dans la boucle? Tu refais le filtre a chaque itération, quel est l'utilité?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
'Remplacer les points par des virgules'
    Cells(i, 24) = Replace(Cells(i, 24).Value, ".", ",")
    Cells(i, 25) = Replace(Cells(i, 25).Value, ".", ",")
    Cells(i, 26) = Replace(Cells(i, 26).Value, ".", ",")
    Cells(i, 28) = Replace(Cells(i, 28).Value, ".", ",")
    Cells(i, 31) = Replace(Cells(i, 31).Value, ".", ",")
    Cells(i, 32) = Replace(Cells(i, 32).Value, ".", ",")
 
'Modification police date et monétaire'
    Cells(i, 24).Style = "currency"
    Cells(i, 25).Style = "currency"
    Cells(i, 26).Style = "currency"
    Cells(i, 31).Style = "currency"
    Cells(i, 32).Style = "currency"
 
    Cells(i, 5).NumberFormat = "dd/mm/yyyy"
    Cells(i, 6).NumberFormat = "dd/mm/yyyy"
    Cells(i, 7).NumberFormat = "dd/mm/yyyy"
    Cells(i, 29).NumberFormat = "dd/mm/yyyy"
    Cells(i, 30).NumberFormat = "dd/mm/yyyy"

Pour chaque ligne tu modifie cellule par cellule, ce n'est pas du tout efficace
Pourquoi ne pas faire la modification sur toute la colonne directement?

Code:

columns(24).style = "currency"

22/08/2016, 15h41
arochab

Merci pour ton aide halaster08 :D

Effectivement je tâcherai de faire un filtre avancé dans ces conditions à l'avenir.

J'ai bien changé le code pour Style et Currency, en revanche quel serait le code pour le REPLACE ?

Aussi je ne suis pas sûr de comprendre ce que tu m'as dit concernant le filtre. En quoi est il dans la boucle ?

Merci encore,

arochab
22/08/2016, 15h55
halaster08
Citation:

en revanche quel serait le code pour le REPLACE

Je te dirais bien ceci:
Code:

1 2 3 Columns(2).Replace What:=".", Replacement:=",", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False
Mais il met les nombres au format texte malgré le style currency donc je ne pense pas que ça va te convenir

Citation:

Aussi je ne suis pas sûr de comprendre ce que tu m'as dit concernant le filtre. En quoi est il dans la boucle ?

Ligne 16 début de la boucle for
Ligne 68 next
Tout ce qui est entre ces deux lignes est exécuté a chaque itération