Code VBA très lent - en phase d'execution

Version imprimable

Est-ce que quelqu'un saurait identifier pourquoi mon code VBA est si long lorsque je le lance (en moyenne 5 minutes entre le moment où je clique "run" et le moment où il a terminé ?).

Voilà le code :

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
Sub PODM()
'
' PODM Macro
' Macro recorded 31/07/2008 by Leslie Petrequin
'
 
    Sheets("PODM3").Select
 
    Cells.Select
    Selection.Delete Shift:=xlUp
 
    Sheets("PODM2").Select
    ActiveWindow.ScrollRow = 1
    Columns("D:I").Select
    Selection.Copy
 
    Sheets("PODM3").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    Application.Run "efface_A_vide"
 
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "concatene"
    With ActiveCell.Characters(Start:=1, Length:=9).Font
        .Name = "Arial"
        .FontStyle = "Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 2
    End With
 
    Sheets("PODM3").Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=CLEAN(RC[-2]&RC[-1])"
    Selection.AutoFill Destination:=Range("C2:C" & Range("A2").End(xlDown).Row), Type:=xlFillDefault
 
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
    Columns("C:C").Select
    ActiveWorkbook.Names.Add Name:="concatenecountryskugen", RefersToR1C1:= _
        "=PODM3!C3"
 
End Sub
 
 
Perut-être est ce que ça vient de ce bout de code qui correspond à     "efface_A_vide" ?
Sub efface_A_vide()
Application.ScreenUpdating = False
 
Dim l As Integer
For l = Cells(65256, 1).End(xlUp).Row To 1 Step -1
If Cells(l, 1).Value = "" Then Cells(l, 1).EntireRow.Delete
Next l
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
 
End Sub

Merci d'avance pour votre aide :)

01/08/2008, 10h48
Pierre Fauconnier

Bonjour et bienvenue sur nos forums.

Le code est largement optimisable, dans la mesure où il n'est pas nécessaire de sélectionner des cellules pour les manipuler...

De plus, une ligne

Code:

application.screenupdating = false

en début de procédure et une ligne

Code:

application.screenupdating = true

en fin de procédure élimera les rafraichissements d'écran (et les clignotements...)

On pourrait aussi passer en calcul manuel durant le procédure, mais il faut y aller prudemment et analyser si le code n'a pas besoin d'un recalcul à un moment donné.

Salut Fairyanna et le forum

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
Sub PODM()
Sheets("PODM3").Activate
UsedRange.Delete
Sheets("PODM2").Range("D:I").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").Replace What:="0", Replacement:="", LookAt:=xlWhole, _
                                            SearchOrder:=xlByRows
Call efface_A_vide
Columns("C:C").Insert Shift:=xlToRight
Range("C1").FormulaR1C1 = "concatene"
With Range("C1").Characters(Start:=1, Length:=9).Font
    .Name = "Arial"
    .FontStyle = "Italic"
    .Size = 8
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = 2
End With
Range("C2").FormulaR1C1 = "=CLEAN(RC[-2]&RC[-1])"
Range("C2").AutoFill Destination:=Range("C2:C" & _
             Range("A2").End(xlDown).Row), Type:=xlFillDefault
Columns(3).Copy
Columns(3).PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Names.Add Name:="concatenecountryskugen", _
       RefersToR1C1:="=PODM3!C3"
End Sub
Sub efface_A_vide()
Dim l As Long
Application.ScreenUpdating = False
For l = [A65256].End(xlUp).Row To 1 Step -1
    If Cells(l, "A") = "" Then Rows(l).Delete
Next l
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Pour moi, pas d'erreur flagrante qui pourrait ralentir dans ton code. Peut-être un problème de taille de ménoire ?
A+

01/08/2008, 14h18
ancel17

Salut,

le code de Gorfael m'a l'air plutot pas mal.

Petite question concernant l'appli efface_a_vide, as-tu besoin de partir de la ligne 65256 ?
Ou veux-tu etre sur de prendre toute les lignes ayant au moins une cellule non vide ?

Dans ce cas tu peux utiliser un SpecialCells(xlTypeLastCell), si tu n'as que 150 ligne à parcourir ça ira plus vite que de vérifier toute les cellules de la plage...
01/08/2008, 22h18
Gorfael

Salut ancel17 et le forum

Citation:

Petite question concernant l'appli efface_a_vide, as-tu besoin de partir de la ligne 65256 ?

J'ai compris la macro comme la feuille ayant en colonne A des formule jusqu'à la dernière (utilisation de Range("A2").End(xlDown).Row dans le code fourni, donc méthode End connue).
Mais je peux me tromper.
A+
02/08/2008, 15h35
zazaraignée
En fait, à partir du moment ou un code comporte plein de 'Select', il faut s'attendre à voir l'exécution ralentie. Les solutions proposées sont à priori toutes les deux bonnes, soient :
- Éliminer tous les Select en faisant les opérations directement sur les feuilles et leurs objets Range,
- Débuter le traitement par une désactivation du 'ScreenUpdating' et en terminant par son activation (retour à la normale).