Discussion :

[shadypierre]

Bonjour à tous, actuellement en stage je solicite votre aide dans le but d'optimiser mon application afin que celle-ci mette le moins de temps possible à s'executer. Mon application génére des fichiers textes et un fichier .xls (3fichiers textes et 1 .xls via un premier formulaire, puis 7 fichiers textes avec lecture du fichier .xls via un second formulaire). J'ai déja reussi à réduire le temps d'execution de 12sec à 6sec pour la première partie et de 22sec à 13sec pour la seconde partie, mais cela ne semble pas encore assez pour mon maitre de stage

Voici mon code du 1er formulaire (raccourci à l'écriture d'un fichier txt et du .xls)

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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 
Option Compare Database
Option Explicit
 
Public Sub btnGenZpdl_Click()
    'Déclaration variable
		Dim db As Database
        Set db = CurrentDb()
        'Requetes
        Dim wLv_SqlSelectDonneesAdresses As String
        'RecordSet
        Dim wLt_donneesAdresses As Recordset
        'All
        Dim wLv_random As Integer, wLv_nbGen As Integer, i As Integer, j As Integer, k As Integer, l As Integer, wLt_nbDonneesAdresses As Integer
        Dim wLt_tabStruct() As Variant, wLt_tabXls As Variant
        Dim wLv_PDL As String
        Dim exc As New Excel.Application
        'INSTLN
        Dim wLv_idInstln As String
 
        'Contenu des fichiers
        Dim wLv_instln As String
 
 
    'Demande du nb d'install à générer
    wLv_nbGen = Val(InputBox("Combien d'installation voulez-vous générer?", "", "1")) 'nb d'install à générer (convertion String to Int)
    'Si le nb demandé est trop important
    If wLv_nbGen > 1000 Or wLv_nbGen <= 0 Then
        MsgBox "Nombre d'installation impossible, le nombre doit être compris entre 1 et 1000", vbOKOnly + vbCritical
    'Sinon on lance la récupération de données et la génération
    Else
        'Création de la feuille XLS qui contiendra les num. de PDL créés
        exc.Workbooks.Add
        exc.Sheets("Sheet1").Select
        exc.Sheets("Sheet1").Name = "Liste PDL"
        'Défini les en-tete de colonne, les mets en gras, puis défini la taille des colonnes
        exc.Range("A1").Select
        exc.ActiveCell.Value = "N°PDL"
        exc.Selection.Font.Bold = True 'gras
 
 
 
    '-----------------------------------------------------------------------------
    'Recupération des données
        'On recupére la liste des fichiers necesaire à l'entreprise ZPDL, ainsi que leur structures
        wLt_tabStruct = fonction.tabStruct("ZPDL")
 
        'Données d'adresse
        wLv_SqlSelectDonneesAdresses = "SELECT zAdresse.numRue, zAdresse.rue, zAdresse.compRue, zAdresse.codePostal, zAdresse.ville, zAdresse.lieuDit, zAdresse.etage, zAdresse.numApp FROM zAdresse;" 'requete données adresse
        Set wLt_donneesAdresses = db.OpenRecordset(wLv_SqlSelectDonneesAdresses) 'fermé en fin de programme
 
		'Initialise le tableau xls
		wLt_tabXls = exc.ActiveSheet.Range("A1:C1000").Value
 
 
    '-----------------------------------------------------------------------------
    'Traitement des données
        Randomize 'Initialise la génération de nb aléatoire
        k = 1 'permet la boucle de création du nombre de fichier demandé
        l = 2 'défini la ligne de départ d'écriture ds le fichier xls
 
        '-----------------------------------------------------------------------------
        'TEST
        Dim temps As Double
        temps = Timer
        '-----------------------------------------------------------------------------
 
        Do While k <= wLv_nbGen
            'Generation num PDL
            wLv_PDL = fonction.PDL()
 
            'On controle les données d'adresse
            'Génération nb aléatoire en fonction du nb d'adresse dispo
            wLt_donneesAdresses.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb d'adresse dispo
            wLt_nbDonneesAdresses = wLt_donneesAdresses.RecordCount - 1 'récupére le nb max de d'adresse et retire 1
            i = 0
            Do While i < 100 'par sécurité on ne boucle que 100fois
                wLt_donneesAdresses.MoveFirst 'replace le RecordSet au début
                wLv_random = Int((wLt_nbDonneesAdresses * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb adresse]
                wLt_donneesAdresses.Move wLv_random
                'On verifie que les champs necessaire sont bien renseigné
                If wLt_donneesAdresses!rue <> "" And wLt_donneesAdresses!ville <> "" And wLt_donneesAdresses!codePostal <> "" Then
                    'Si aucune option requise
                    If cb_numHouse.Value = 0 And cb_etage.Value = 0 And cb_complRue = 0 And cb_numApp = 0 And cb_lieuDit = 0 And cb_lieu = 0 Then
                        'On sort de la boucle
                        Exit Do
                    'Si option requise
                    Else
                        'On verifie que les champs optionel sont renseigné
                        If wLt_donneesAdresses!numRue <> "" And wLt_donneesAdresses!compRue <> "" And wLt_donneesAdresses!lieuDit <> "" Then
                            'On sort de la boucle
                            Exit Do
                        End If
                    End If
                End If
                i = i + 1
            Loop
 
            '-------------------------------------------------------------------------
            'INSTLN
                'Identifiant unique de l'installation
                wLv_idInstln = fonction.idInstln(wLv_PDL)
 
                'On construit le fichier
                    'ligne1
                wLv_instln = wLv_idInstln & vbTab & wLt_tabStruct(3, 1) & vbTab & "E" & vbTab & wLv_idLieuConso & vbTab & "X" & vbTab & "Z001" & vbTab & "EPOHI" & vbCrLf
                    'ligne2
                wLv_instln = wLv_instln & wLv_idInstln & vbTab & wLt_tabStruct(3, 2) & vbTab & wLv_PDL & vbTab & "GRD ELEC" & vbCrLf
                    'ligne3
                wLv_instln = wLv_instln & wLv_idInstln & vbTab & WLV_FIN
 
                'Ecriture du fichiers INSTLN
                Open CurrentProject.Path & "\INSTLN.txt" For Append As #3
                    Print #3, wLv_instln
                Close #3
 
            'On stock le numero de PDL dans wLt_tabXls (ligne, colonne)
            wLt_tabXls(k, 1) = wLv_PDL
 
            k = k + 1 'on incrémente k
            l = l + 1 'on incrémente l (pour le fichier xls)
        Loop 'boucle création de k fichiers
 
         'Copie le tableau dans le fichier .xls    
        exc.ActiveSheet.Range("A2:A" & l).Value = wLt_tabXls
 
 
        'On ferme le RecordSet d'adresse
        wLt_donneesAdresses.Close
 
        'Enregistrement du fichier XLS
        'Si le fichier .xls existe déja on le supprime
        If Dir(CurrentProject.Path & "\ZPDL.xls") <> "" Then
            Kill (CurrentProject.Path & "\ZPDL.xls")
        End If
        exc.ActiveWorkbook.SaveAs FileName:=CurrentProject.Path & "\ZPDL.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        'Ferme et libère le fichier XLS
        exc.ActiveWorkbook.Close
        exc.Quit
        Set exc = Nothing
 
 
        '-----------------------------------------------------------------------------
        'TEST
        MsgBox Timer - temps
        '-----------------------------------------------------------------------------
 
 
        'On affiche un msg pour prévenir l'utilisateur de la bonne marche du programme
        MsgBox "Fichiers générés avec succès", vbOKOnly + vbInformation
 
    'Fin boucle verification wLv_nbGen < 1000
    End If
 
End Sub

Et celui de mon second formulaire (1seul fichier texte qui utilise la lecture du fichier .xls)

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
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
 
Option Compare Database
Option Explicit
 
'Evenement sur click génération fichier MOH_P
Private Sub btn_genMOH_Click()
    'Déclaration variable
        Dim db As Database
        Set db = CurrentDb()
        'Requetes
        Dim wLv_SqlSelectDonneesAdresses As String, wLv_SqlSelectDonneesClients As String, wLv_SqlSelectDonneesCadrans As String, wLv_SqlSelectDonneesNomsManuel As String
        'RecordSet
        Dim wLt_donneesAdresses As Recordset, wLt_donneesClients As Recordset, wLt_donneesCadrans As Recordset
        'All
        Dim wLv_PDL As String, wLv_cheminFichier As String
        Dim i As Long, j As Long, k As Long, wLt_nbDonneesAdresses As Long
        Dim wLv_random As Integer, wLv_numRows As Integer, wLt_nbDonneesClients As Integer, wLt_nbDonneesCadrans As Integer
        Dim wLt_tabStruct() As Variant, wLt_tabXls As Variant
        Dim exc As New Excel.Application
        'PREMISECHA
        Dim wLv_idModLieuConso As String
 
        'Contenu des fichiers
        Dim wLv_premisecha As String
 
 
    '-----------------------------------------------------------------------------
    'Recupération des données
        'On recupére la liste des fichiers necesaire à l'entreprise MOH_P, ainsi que leur structures
        wLt_tabStruct = fonction.tabStruct("MOH_P")
 
        'Données d'adresse
        wLv_SqlSelectDonneesAdresses = "SELECT zAdresse.numRue, zAdresse.rue, zAdresse.compRue, zAdresse.codePostal, zAdresse.ville, zAdresse.lieuDit, zAdresse.etage, zAdresse.numApp, zAdresse.GSR, zAdresse.numConcession FROM zAdresse;" 'requete données adresse
        Set wLt_donneesAdresses = db.OpenRecordset(wLv_SqlSelectDonneesAdresses) 'fermé en fin de programme
        'Données client
        wLv_SqlSelectDonneesClients = "SELECT zClient.nom, zClient.prenom, zClient.titre, zClient.dateNais FROM zClient;" 'requete données client
        Set wLt_donneesClients = db.OpenRecordset(wLv_SqlSelectDonneesClients) 'fermé en fin de programme
        'Données cadran
        wLv_SqlSelectDonneesCadrans = "SELECT zCadran.groupe, zCadran.nbCadran FROM zCadran;" 'requete données cadran
        Set wLt_donneesCadrans = db.OpenRecordset(wLv_SqlSelectDonneesCadrans) 'fermé en fin de programme
 
        'Récupération du fichier XLS ("Fenetre Parcourir...")
        wLv_cheminFichier = openFile.OuvrirUnFichier(Me.Hwnd, "Parcourir", 1, "Fichier Excel", "xls")
 
 
    '-----------------------------------------------------------------------------
    'Traitement des données
        'On vérifie que le formulaire contient les infos nécessaires
        If wLv_cheminFichier = "" Or IsNull(cbb_catTarif.Value) Then
            'Affiche message d'erreur en fonction du cas
            If wLv_cheminFichier = "" Then
                MsgBox "Vous devez obligatoirement selectionner un fichier Excel", vbOKOnly + vbInformation
            ElseIf IsNull(cbb_catTarif.Value) Then
                MsgBox "Vous devez obligatoirement selectionner une catégorie de tarif", vbOKOnly + vbInformation
            End If
        Else
            'On ouvre le fichier xls sélectionné
            exc.Workbooks.Open (wLv_cheminFichier)
            exc.Visible = False
            'On compte le nb de lignes dans le fichier (sans compter la cell d'entete)
            wLv_numRows = exc.ActiveSheet.UsedRange.Rows.Count - 1
            'On stock le contenu du xls dans un Array (ligne, colonne)
            wLt_tabXls = exc.ActiveSheet.Range("A1:C" & wLv_numRows).Value
 
            'Initialise la génération de nb aléatoire
            Randomize
 
            '-----------------------------------------------------------------------------
            'TEST
            Dim temps As Double
            temps = Timer
            '-----------------------------------------------------------------------------
 
            'Boucle de création des fichiers en fonction du nb de ligne ds le fichier xls _
            '(on soustrait 1 au nb de ligne car la première ligne d'en-tête n'est pas lu)
            j = 1
            Do While j <= wLv_numRows - 1
 
                'On controle les données client
                'Génération nb aléatoire en fonction du nb de client dispo
                wLt_donneesClients.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb d'adresse dispo
                wLt_nbDonneesClients = wLt_donneesClients.RecordCount - 1 'récupére le nb max de client et retire 1
                i = 0
                Do While i < 100 'par sécurité on ne boucle que 100fois
                    wLt_donneesClients.MoveFirst 'replace le RecordSet au début
                    wLv_random = Int((wLt_nbDonneesClients * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb adresse]
                    wLt_donneesClients.Move wLv_random
                    'On verifie que les champs necessaire sont bien renseigné
                    If wLt_donneesClients!nom <> "" And wLt_donneesClients!prenom <> "" And wLt_donneesClients!dateNais <> "" Then
                        'Si aucune option requise
                        If cb_sexe.Value = 0 Then
                            Exit Do
                        'Si option requise
                        Else
                            'On verifie que les champs optionel sont renseigné
                            If wLt_donneesClients!Titre <> "" Then
                                Exit Do
                            End If
                        End If
                    End If
                    i = i + 1
                Loop
 
 
                'On controle les données d'adresse
                'Génération nb aléatoire en fonction du nb d'adresse dispo
                wLt_donneesAdresses.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb d'adresse dispo
                wLt_nbDonneesAdresses = wLt_donneesAdresses.RecordCount - 1 'récupére le nb max de d'adresse et retire 1
                i = 0
                Do While i < 100 'par sécurité on ne boucle que 100fois
                    wLt_donneesAdresses.MoveFirst 'replace le RecordSet au début
                    wLv_random = Int((wLt_nbDonneesAdresses * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb adresse]
                    wLt_donneesAdresses.Move wLv_random
                    'On verifie que les champs necessaire sont bien renseigné
                    If wLt_donneesAdresses!rue <> "" And wLt_donneesAdresses!ville <> "" And wLt_donneesAdresses!codePostal <> "" And wLt_donneesAdresses!GSR <> "" And wLt_donneesAdresses!etage <> "" And wLt_donneesAdresses!numApp <> "" And wLt_donneesAdresses!numConcession <> "" Then
                        Exit Do
                    End If
                    i = i + 1
                Loop
 
 
                'On controle les données cadran
                'Génération nb aléatoire en fonction du nb de cadran dispo
                wLt_donneesCadrans.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb de cadran dispo
                wLt_nbDonneesCadrans = wLt_donneesCadrans.RecordCount - 1 'récupére le nb max de cadran et retire 1
                i = 0
                Do While i < 100 'par sécurité on ne boucle que 100fois
                    wLt_donneesCadrans.MoveFirst 'replace le RecordSet au début
                    wLv_random = Int((wLt_nbDonneesCadrans * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb cadran]
                    wLt_donneesCadrans.Move wLv_random
                    'On verifie que les champs necessaire sont bien renseigné
                    If wLt_donneesCadrans!groupe <> "" And wLt_donneesCadrans!nbCadran = optgr_typeApp Then
                        Exit Do
                    End If
                    i = i + 1
                Loop
 
 
                'Generation num PDL
                wLv_PDL = fonction.PDL()
 
 
                '-----------------------------------------------------------------------------
                'PREMISECHA -> 4
                    'Clé externe de la modification
                    wLv_idModLieuConso = fonction.idModLieuConso(wLv_PDL)
                    '
 
                        'ligne1 -> Identification
                    wLv_premisecha = wLv_idModLieuConso & vbTab & wLt_tabStruct(4, 1) & vbTab & wLt_tabXls(j, 3) & vbTab & "" & vbTab & "info sup lieu conso" & vbTab & wLt_donneesAdresses!etage & vbTab & wLt_donneesAdresses!numApp & vbCrLf
 
                        'ligne2 -> Fin
                    wLv_premisecha = wLv_premisecha & wLv_idModLieuConso & vbTab & WLV_FIN
 
 
                    'Ecriture du fichiers PREMISECHA
                    Open CurrentProject.Path & "\PREMISECHA.txt" For Append As #4
                        Print #4, wLv_premisecha
                    Close #4
 
 
            '-----------------------------------------------------------------------------
 
                'Incrémentation pour la boucle de création des fichiers en fonction du nb de PDL inscrit ds le fichier xls
                j = j + 1
            Loop
 
 
            '-----------------------------------------------------------------------------
            'On ferme les RecordSet
            wLt_donneesAdresses.Close
            wLt_donneesClients.Close
            wLt_donneesCadrans.Close
            'Ferme et libère le fichier XLS
            exc.ActiveWorkbook.Close
            exc.Quit
            Set exc = Nothing
 
            '-----------------------------------------------------------------------------
            'TEST
            MsgBox Timer - temps
            '-----------------------------------------------------------------------------
 
            'On affiche un msg confirmant la bonne marche du programme
            MsgBox "Fichiers générés avec succès", vbOKOnly + vbInformation
 
        'Fin si de vérification de la selection d'un fichier xls et champs
        End If
 
End Sub

En gros le programme récupére dans la base de données les fichiers qu'il doit créer ainsi que leur structures respective (structure = nom des lignes de chaque fichiers textes, donc si il y a 5structures il y aura 5lignes dans le fichier texte), puis il récupére les données utile en totalalité et les insère de manière aléatoire à chaque génération. Puis à la fin il enregistre les numéro généré dans un fichier .xls

J'espère que je suis clair car c'est pas vraiment facile à expliquer comme ça


ps : evidement si il ne s'agisait de créer que c'est 10fichiers txt et le .xls ça ne prendrais que 1sec mais la il y à une boucle qui demande combien on veux en générer le processus et donc bouclé jusqu'a 1000fois

Merci d'avance à tous

[marot_r]

Surtout éviter d'ouvrir et de fermer à répétition ton fichier texte.

Ouvrir le fichier texte avant la boucle, y écrire dans la boucle, fermer le fichier après la boucle.

Après on est dans de la micro optimisation :

* Éviter le SQL en dans le code, le remplacer par l'appel à une requête Access.

Exemple :

Code :

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

Set wLt_donneesAdresses = db.OpenRecordset("NomTaRequete")

Cela va permettre au motteur de la BD d'optimiser l'exécution du SQL ce qu'il ne peut pas faire avec du SQL à la volée.

* Fermer ta bd en sortie de procédure et libérer la mémoire associée avec :

Code :

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

db.close:set db=nothing

* Libérer la mémoire utilîsée par tes recordset.

Exemple :

Code :

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

wLt_donneesAdresses.Close:set wLt_donneesAdresses=nothing

* Remplacer les do while loop par des for next quand tu sais combien d'ittérations vont être exécuter et que ton incrément est régulier. Il se peut très bien que le compilateur soit assez intelligent pour le faire lui-même mais cela devrait lui simplifier la vie.

* Faire exécuter le programme sur une machine plus rapide avec plus de mémoire, un meilleure connexion réseau :-) ce qui est bien plus rentable financièrement que de payer un programmeur a améliorer un code déjà assez rapide.

A+

[shadypierre]

Merci beaucoup de t'être penché sur mon sujet, je met ça en place de suite et je viens donner le résultat de ce que ça donne

[shadypierre]

Ouch en effet impressionant le changement est radical. Je passe de 13,6sec en moyenne pour la génération de 1000*3 fichiers, à 1.8sec!!! Magnifique, exactement le résultat que j'attendais. J'avais déja essayé de modifier l'écriture des fichiers, mais je n'avais au final fait qu'augmenter le temps en faisant une écriture massive en fin de fichier (doublement le temps d'execution xD)

Vraiment merci car j'avais pas penser à simplement ouvrir avant les fichiers et écrire pas à pas

[marot_r]

Ta méthode avait les avantages suivants :

• Simplicité
• Utilisation un temps minimal des ressources.
• Garantie quasi absolue que tes données seront bien écrites puisque la fermeture du fichier force windows a écrire l'information sur le disque.
• Temps d'exécution acceptable

L'optimisation est impressionnante mais il va falloir exécuter ton code un grand nombre de fois pour rentabiliser le temps que tu a passé à le mettre au point.

A+