Optimisation de code

**xdoreau** · 13/02/2009, 15h31

Bonjour,

J'ai mis en place l'importation et le traitement de fichiers au format csv dans un classeur excel. Le code fonctionne très bien à l'ouverture du fichier excel mais je constate un ralentissement considérable si je traite un second ou plusieurs fichiers à la suite. Je ne suis pas un pro de VBA et j'ai donc surement commis des erreurs pour que mon code s'exécute plus rapidement.

Si vous pouviez avoir la gentillesse de me corriger tout en m'expliquant mes erreurs je serais assez preneur.

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
129
130
131
132
133
134
135
136
137
138
139
140
141
 
    Dim i As Long
    Dim DerniereColPleine As Long
 
'''''désactiver le rafraîchissement de l'écran pour accélérer le traitement
    Application.ScreenUpdating = False
 
''''''éffacement des données restantes si il y en a
    Range("A1").Select
        If AcitveCell <> "" Then
            Range("A65536", Range("IV65536").End(xlUp)).Select
            Selection.EntireRow.Delete
        End If
    Range("A1").Select
 
'''''importation du fichier csv sélectionné dans la combobox
    Workbooks(1).Worksheets(1).Select
        Set shFirstQtr = Workbooks(1).Worksheets(1)
        Set qtQtrResults = shFirstQtr.QueryTables.Add(Connection:="TEXT;J:\" & ComboBox1.Value, Destination:=shFirstQtr.Cells(1, 1))
        With qtQtrResults
            .TextFileColumnDataTypes = Array(xlTextFormat, xlTextFormat, xlTextFormat, xlTextFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat)
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .AdjustColumnWidth = True
            .Delete
        End With
 
''''''suppression des colonnes non sélectionnés par l'utilisateur via checkbox
    If UserForm1.CheckBox1 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock BC1" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox2 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 03" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox3 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 10" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox4 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 14" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox5 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 23" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox6 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 45" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox7 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock 89" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox8 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "stock ent" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
    If UserForm1.CheckBox9 = False Then
        Range("A1", Range("L1").End(xlUp)).Select
        For i = Selection.Cells.Count To 1 Step -1
            If Selection.Cells(i).Value = "ref fourniseur" Then
                Selection.Cells(i).EntireColumn.Delete
            End If
        Next i
    End If
 
'''''suppression des lignes vides du fichiers csv 1 sur 2
    Range("A1", Range("A65536").End(xlUp)).Select
    For i = Selection.Cells.Count To 1 Step -1
        If Selection.Cells(i).Value = "" Then
            Selection.Cells(i).EntireRow.Delete
        End If
    Next i
 
'''''bordures des cellules
    Range("A1").Select
    With Range("A1").CurrentRegion
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
 
'''''mise en forme entête de colonne
    DerniereColPleine = Range("1:1").Find("*", , , , xlByColumns, xlPrevious).Column
    Range("A1", Cells(1, DerniereColPleine)).Select
    Selection.Font.Size = 10
    Selection.Font.Italic = True
    Selection.Interior.ColorIndex = 15
 
'''''si trop de colonnes mise au format paysage
    Range("J1").Select
    If ActiveCell <> "" Then
        With ActiveSheet
            .PageSetup.Orientation = xlLandscape
        End With
    End If
 
''''' fin de traitement
    Range("A1").Select
    Set shFirstQtr = Nothing
    Set qtQtrResults = Nothing
 
''''' fermeture du UserForm
End

Je vous remercie par avance

**aalex_38** · 13/02/2009, 15h50

Bonjour,

En fin de traitement il faut penser à remettre le rafraichissement de l'écran:

Code :

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

Application.ScreenUpdating = TRUE

Tu dis.

**xdoreau** · 13/02/2009, 17h44

Merci du conseil aalex_38

J'ai remis le rafraîchissement de l'écran en fin de traitement j'ai aussi trouvé dans un autre sujet une façon plus rapide de supprimer les lignes vides dans un tableau mais le résultat n'est pour l'instant pas terrible en terme de rapidité

**DarkVader** · 13/02/2009, 17h45

Envoyé par xdoreau

.../...
Si vous pouviez avoir la gentillesse de me corriger tout en m'expliquant mes erreurs je serais assez preneur.
.../...

L'enregistreur de macros vaut ce qu'il vaut mais il a le mérite d'exister,
toutefois son premier défaut est que le code est produit depuis les interventions de l'utilisateur
incluant de fait un jeu de select/selection que le développeur amateur trouvera normal de reproduire.

Pour obtenir un code propre et efficace, sans risque de collisions avec l'utilisateur,
il est essentiel de remplacer ces selections par des références d'objects.

Exemple
Plutôt que

Code :

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

1
2
Range("A1").Select
        If AcitveCell <> "" Then '.../..

il faut écrire

Code :

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

1
2
3
Dim myRange as Range
set myRange=Worksheets("theSheet").Range("A1")
        If MyRange <> "" Then '.../..

Optimisation de code

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager