Discussion :

[Thibaut63]

Bonjour,

Je suis actuellement en stage ou je développe une passerelle entre deux logiciels
sur les mouvements de troupes des ovins ( gestion des brebis et des agneaux ).
Je programme en VB6, langage imposé par mon stage..
Une partie de mon programme consiste à récupérer des informations d'un fichier texte, et, avec celles-ci, remplir un classeur excel.
Pour le code pas de problème tout à l'air de fonctionné. En revanche le temps d'exécution est relativement long ( 5 min pour 10 000 lignes environ à traiter ) sachant que je travail sous W7, avec un processeur Intel Xeon W3520, 4 Go de Ram. J'ai peur que le temps d'exécution soit d'autant plus long sur un ordinateur de moindre facture.

Je débute en VB6, je vous joint donc la boucle principale de mon programme, en espérant que vous puissiez me fournir quelques pistes qui m'aiderai a optimiser mon programme. Quelques explications s'impose :

-Je pars d'un fichier "EctorToOvitel" contenant des ligne comme celle - ci :
44150940910,,F,15/05/1994,Brebis,31,,,,,,18/07/2005,Boucherie,,

-Je dispose d'un fichier "Template_Export - Base.xls", à complété par le fichier "EctorToOvitel". Ce classeur contient deux feuilles, mise en forme.

-Le résultat final doit être enregistré dans un fichier "Template_Export.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
191
192
193
194
195
196
197
198
199
200
201
Private Sub ButtonOui_Click()
 
reponse_consult = True 'le traitement est lancé depuis une form oui/non
 
'Déclaration des variables
Dim ligne() As String 'permet de récupérer les lignes du fichier à traiter
Dim i As Integer
Dim fichier, xlApp, xlBook, xlWks, xlRange As Variant 'Pour mon fichier excel ..
Dim position_1 As Integer   'positionnement dans la ligne de manière a récupéré les information voulu
Dim position_2 As Integer   'idem
Dim pourcentage As Double   ' pour la barre de progression
Dim N_nat As String         'les varaible "N_" permet la récupération des données voulus
Dim N_natm As String
Dim N_sexe As String
Dim N_datenaiss As String
Dim N_categ As String
Dim N_mortne As String
 
'Suppresion du fichier final si déja existant
Set filesys = CreateObject("Scripting.FileSystemObject")
le_chemin_du_fichier = "C:\AOV\Troup\Template_Export.xls"
If filesys.FileExists(le_chemin_du_fichier) Then
        Kill le_chemin_du_fichier
End If
 
 
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(adresseFichier & " - EctorToOvitel") 'Fichier de base
 
For i = 1 To nbBrebis
        For j = 1 To TBrebis(i).nbAgneau
        totalA = totalA + 1
        Next j
Next i
 
 
fichier = "C:\AOV\Troup\Template_Export - Base.xls"
 
' Création de l'objet Excel (une classe)
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(fichier)
' Positionnement à l'intérieur du classeur
Set xlWks = xlBook.Worksheets(1)
Set xlRange = xlWks.Range("A1:A65535")
 
'Affichage de la barre de progression pour faire patienter =D
With calculsEnCours
    .ShowBar saisie
    .Refresh
    .Label2.Caption = "Traitement en cours ..."
End With
 
'initialisation de la barre de progression
pourcentage = 100 / (nbBrebis + totalA) 'nbBrebis + totalA donne le nombre total de ligne a traité
i = 2 'les premières lignes sont déja remplis dans le fichier de base
j = 2
 
Excel.Application.Calculation = xlCalculationManual 'ligne trouvé sur internet qui était "censé" diminuer le temps dem on programme
 
Do Until f.AtEndOfStream
    position_1 = 1
 
    'Lecture première ligne
    ReDim Preserve ligne(i)
    ligne(i) = f.ReadLine
 
    'N° nat
    position_1 = InStr(1, ligne(i), ",")
    N_nat = Mid(ligne(i), 1, position_1 - 1)
    xlRange.Cells(i, 1).Value = N_nat 'je récupére la valeur voulu dans la ligne que j'insère dans mon tableau
    'je sauvegarde la valeur dans N_nat pour l'utiliser aussi dans la feuille 2 !
 
    'sexe
    position_1 = position_1 + 2
    N_sexe = Mid(ligne(i), position_1, 1)
    xlRange.Cells(i, 3).Value = N_sexe
 
    'Date de naissance
    position_1 = position_1 + 2
    N_datenaiss = Mid(ligne(i), position_1, 10)
    xlRange.Cells(i, 4).NumberFormat = "mm/dd/yyyy"
    xlRange.Cells(i, 4).Value = N_datenaiss
 
    'Categorie
    position_1 = position_1 + 11
    position_2 = InStr(position_1, ligne(i), ",")
    N_categ = Mid(ligne(i), position_1, (position_2 - position_1))
    xlRange.Cells(i, 5).Value = N_categ
 
    'N° race
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 6).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Poids naissance
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 7).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Date sevr
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 8).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'N° nat mere
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 9).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'N° trav mere
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 10).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Date achat
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 11).NumberFormat = "mm/dd/yyyy"
    xlRange.Cells(i, 11).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Date vente
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 12).NumberFormat = "mm/dd/yyyy"
    xlRange.Cells(i, 12).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Cause vente
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 13).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Date perte
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    xlRange.Cells(i, 14).NumberFormat = "mm/dd/yyyy"
    xlRange.Cells(i, 14).Value = Mid(ligne(i), position_1, (position_2 - position_1))
 
    'Dans mon fichier d'origine, les ligne sont structurées. D'abord la ligne d'une brebis puis en dessous
    'les agneaux correspondant à cette brebis.
    '***
    'La feuille 2 ne contient que les agneaux, mais aussi le numéro de leur mére
    If N_categ = "Brebis" Then
        N_natm = N_nat 'sauvegarde du numéro de mere
    ElseIf N_categ = "Agneaux" Then
        Set xlWks = xlBook.Worksheets(2)
        Set xlRange = xlWks.Range("A1:A65535")
        xlRange.Cells(j, 1).Value = N_natm
        xlRange.Cells(j, 3).NumberFormat = "mm/dd/yyyy"
        xlRange.Cells(j, 3).Value = N_datenaiss
        xlRange.Cells(j, 5).Value = "FAUX"
 
        If N_sexe = "I" Then
            N_mortne = "VRAI"
            N_sexe = "M"
        Else
            N_mortne = ""
        End If
 
        xlRange.Cells(j, 7).Value = N_sexe
 
         'Gestion d'un cas particulier ...
        If Mid(N_nata, 2) = "0000" Then
                Randomize
                N_nat = Mid(N_nata, 1, 1) & "000" & (Int(Rnd * 9) + 1)
        End If
 
        xlRange.Cells(j, 8).Value = N_nat
        xlRange.Cells(j, 9).Value = N_mortne
 
        'On repasse sur la feuille générale
        Set xlWks = xlBook.Worksheets(1)
        Set xlRange = xlWks.Range("A1:A65535")
        j = j + 1
    End If
 
    'on met a jour la barre de progression
        calculsEnCours.ProgressBar1.Value = Round(i * pourcentage, 1)
 
    'incrémentation
    i = i + 1
Loop
 
'on enleve la barre de progression
Unload calculsEnCours
 
Excel.Application.Calculation = xlCalculationAutomatic
 
f.Close
 
xlBook.SaveAs FileName:="C:\AOV\Troup\Template_Export.xls"
xlBook.Close
xlApp.Quit
fichier = "C:\AOV\Troup\Template_Export.xls"
 
'il m'est demandé de lancer excel avec le fichier OK
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(fichier)
xlApp.Application.Visible = True
Unload Recuperation
 
End Sub

Je vous remercie par avance, les personnes qui prendront le temps de s'intéréssés a mon message.

Cordialement,

Thibaut

[DarkVader]

Bonjour,

Affecter des données cellule par cellule est une méthode à éviter - il faut travailler avec des plages de données :
1°) tu formates tes données dans un tableau global
2°) tu affectes les formats des cellules (par colonnes ou plages )
3°) tu affectes le tableau de données à la plage de cellules en 1 seule opération
4°) accessoirement tu joues sur la propriété screenupdating durant l'affectation

PS: une seule instance de filesystem pour toute la procédure

[Thibaut63]

Bonjour DarkVader,

Tout d'abord merci beaucoup pour votre réponse si rapide.
Je vais tester de ce pas de modifier mon fichier comme vous me l'avez suggéré.
Je vous en donne des nouvelles cette après-midi.

[DarkVader]

Exemples pour travailler avec des affectations par plage :
http://www.developpez.net/forums/d65...copie-tableau/

[Thibaut63]

Bon, je galère vraiment beaucoup.
Des grosses lacunes sur le bases...
Surtout que mon amis google me renvoi toujours vers du "VBA"

Code :

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

1
2
3
4
5
6
7
'1°) tu formates tes données dans un tableau global
Do Until f.AtEndOfStream
    'Lecture première ligne
    ReDim Preserve ligne(i)
    ligne(i) = f.ReadLine
    i = i + 1
Loop

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
'2°) tu affectes les formats des cellules (par colonnes ou plages )
Columns("D:D").NumberFormat = "mm/dd/yyyy"
Columns("H:H").NumberFormat = "mm/dd/yyyy"
Columns("K:K").NumberFormat = "mm/dd/yyyy"
Columns("L:L").NumberFormat = "mm/dd/yyyy"
Columns("N:N").NumberFormat = "mm/dd/yyyy"
Set xlWks = xlBook.Worksheets(2)
Set xlRange = xlWks.Range("A1:A65535")
Columns("C:C").NumberFormat = "mm/dd/yyyy"
Set xlWks = xlBook.Worksheets(2)
Set xlRange = xlWks.Range("A1:A65535")

L'étape 3 me bloque un peu, je ne vois vraiment pas quelle fonction utilisée.
Une sorte de :

Code :

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

1
2
3
For j = 2 To i
    xlWks.Range(j).Value = ligne(j)
Next j

Connaissez vous des tutoriels VB6 parlant d'Excel ? C'est la cata là ...

[ProgElecT]

Applications Office

[DarkVader]

Bon, je galère vraiment beaucoup.
Des grosses lacunes sur le bases...
Surtout que mon amis google me renvoi toujours vers du "VBA"

Cela revient au même

Code :

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

1
2
3
4
5
6
7
'1°) tu formates tes données dans un tableau global
Do Until f.AtEndOfStream
    'Lecture première ligne
    ReDim Preserve ligne(i)
    ligne(i) = f.ReadLine
    i = i + 1
Loop

1°) Comme la méthode d'affectation par bloc ne permet que d'affecter un tableau complet
il serait nécessaire de sauter les 1ères lignes si comme tu l'indiques plus bas
l'affectation s'effectue à partir de ligne(2)
2°) Tu dois définir un tableau à 2 dim pour lequel chaque valeur va correspondre à une cellule -
Tel que le tableau est défini, il n'y a aucun formatage du tableau :
il manque une opération pour spliter chaque ligne.

Code :

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

1
2
3
4
5
6
7
 
'2°) tu affectes les formats des cellules (par colonnes ou plages )
Columns("D:D").NumberFormat = "mm/dd/yyyy"
Columns("H:H").NumberFormat = "mm/dd/yyyy"
Columns("K:K").NumberFormat = "mm/dd/yyyy"
Columns("L:L").NumberFormat = "mm/dd/yyyy"
Columns("N:N").NumberFormat = "mm/dd/yyyy"

Non,
1°) tu dois utiliser l'object worksheet de référence
2°) une seule propriété => une seule ligne

Code :

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

xlbook.Worksheets(2).columns("D: D;H:H;K:L;N:N").Numberformat="mm/dd/yyyy"

Code :

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

1
2
3
4
5
6
 
Set xlWks = xlBook.Worksheets(2)
Set xlRange = xlWks.Range("A1:A65535")
Columns("C:C").NumberFormat = "mm/dd/yyyy"
Set xlWks = xlBook.Worksheets(2)
Set xlRange = xlWks.Range("A1:A65535")

L'étape 3 me bloque un peu, je ne vois vraiment pas quelle fonction utilisée.
Une sorte de :

Code :

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

1
2
3
For j = 2 To i
    xlWks.Range(j).Value = ligne(j)
Next j

...

!!!
Tu as parcouru le lien indiqué ?

Code :

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

1
2
3
4
5
6
7
 
' Formater l'object Range
set xlRange=xlWks.Range("A1") ' Origine de la copie
set xlRange=xlRange.resize(ubound(ligne),ubound(ligne,2) ' Plage reformatée pour correspondre exactement en taille au tableau
 
' Affecter le tableau à la plage de cellules
xlRange.value=ligne()

[Thibaut63]

Tout d'abord je tiens à vous remercier grandement du temps que vous m'accordez, la rapidité et la pertinence de vos réponses me sont très précieuses.

J'approche à grand pas du but, et je suis bluffé par la rapidité d'exécution de votre code. Il me reste encore des petites erreurs

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
'1°) tu formates tes données dans un tableau global
i = 2
 
Do Until f.AtEndOfStream
    j = 0
    'Lecture première ligne
    ReDim Preserve ligne(i)
    ligne(i) = f.ReadLine
 
    ReDim Preserve TabI(i, 15) ' ERREUR!
 
    'N° nat
    position_1 = InStr(1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), 1, position_1 - 1)
    j = j + 2
 
    'sexe
    position_1 = position_1 + 2
    TabI(i, j) = Mid(ligne(i), position_1, 1)
    j = j + 1
 
    'Date de naissance
    position_1 = position_1 + 2
    TabI(i, j) = Mid(ligne(i), position_1, 10)
    j = j + 1
 
    'Categorie
    position_1 = position_1 + 11
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'N° race
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Poids naissance
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    N_pdsnaiss = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Date sevr
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'N° nat mere
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'N° trav mere
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Date achat
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Date vente
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Cause vente
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
 
    'Date perte
    position_1 = position_1 + (position_2 - position_1) + 1
    position_2 = InStr(position_1, ligne(i), ",")
    TabI(i, j) = Mid(ligne(i), position_1, (position_2 - position_1))
    j = j + 1
    i = i + 1
Loop

Dans cette 1ere partie j'ai un problème pour réaffecter mon tableau. Je souhaite à chaque tour, redimensionner mon tableau avec une ligne de plus et toujours 15 colonnes.
" Indice en dehors de la plage "
Si je prend un tableau déjà dimensionné et assez grand, le code, lui, fonctionne bien

Dans la deuxième partie :

Code :

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

1
2
3
'2°) tu affectes les formats des cellules (par colonnes ou plages )
xlBook.Worksheets(1).Columns("D:D;H:H;K:L;N:N").NumberFormat = "mm/dd/yyyy"
xlBook.Worksheets(2).Columns("C:C").NumberFormat = "mm/dd/yyyy"

la première ligne ne passe pas. " Type incompatible "
De plus si j'inverse les deux lignes :

Code :

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

1
2
3
4
 
'2°) tu affectes les formats des cellules (par colonnes ou plages )
xlBook.Worksheets(2).Columns("C:C").NumberFormat = "mm/dd/yyyy"
xlBook.Worksheets(1).Columns("D:D;H:H;K:L;N:N").NumberFormat = "mm/dd/yyyy"

C'est la 2éme ligne qui bug ! J'en ai donc déduit que la feuille active devait être la feuille 2. J'ai testé en utilisant le lien fournit par ProgElecT :

Code :

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

1
2
3
4
5
6
 
'2°) tu affectes les formats des cellules (par colonnes ou plages )
Set xlWks = xlApp.ActiveWorkbook.Sheets(1)
xlWks.Columns("D:D;H:H;K:L;N:N").NumberFormat = "mm/dd/yyyy"
Set xlWks = xlApp.ActiveWorkbook.Sheets(2)
xlWks.Columns("C:C").NumberFormat = "mm/dd/yyyy"

Mais ca ne passe pas non plus ...


Pour la 3ème partie tout semble OK :

Code :

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

1
2
3
4
5
6
7
'3°) tu affectes le tableau de données à la plage de cellules en 1 seule opération
' Formater l'object Range
Set xlRange = xlWks.Range("A1") ' Origine de la copie
Set xlRange = xlRange.Resize(UBound(TabI), UBound(TabI, 2)) ' Plage reformatée pour correspondre exactement en taille au tableau
 
' Affecter le tableau à la plage de cellules
xlRange.Value = TabI()

Encore une fois je vous remercie de votre écoute, de vos explications et du temps que vous m'accordez.

[DarkVader]

.../...Dans cette 1ere partie j'ai un problème pour réaffecter mon tableau. Je souhaite à chaque tour, redimensionner mon tableau avec une ligne de plus et toujours 15 colonnes.
" Indice en dehors de la plage "
Si je prend un tableau déjà dimensionné et assez grand, le code, lui, fonctionne bien

C'est dans la doc d'excel ou vb => F1
Seule la dernière dimension est redimensionnable.

La solution la plus simple est de boucler une première fois pour récupérer toutes les lignes dans un 1er tableau
puis de dimensionner le tableau final et ensuite seulement de boucler une seconde fois pour remplir le tableau final

Dans la deuxième partie :

Code :

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

1
2
3
'2°) tu affectes les formats des cellules (par colonnes ou plages )
xlBook.Worksheets(1).Columns("D:D;H:H;K:L;N:N").NumberFormat = "mm/dd/yyyy"
xlBook.Worksheets(2).Columns("C:C").NumberFormat = "mm/dd/yyyy"

la première ligne ne passe pas. " Type incompatible "
[code]

L'activation des feuilles ne joue aucun role - désolé pour la syntaxe

Code :

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

xlBook.Worksheets(1).Columns("D:D,H:H,K:L,N:N").NumberFormat = "mm/dd/yyyy"

Tu aurais pu trouver par toi même

[Thibaut63]

Yahouu !!

Tout marche,enfin pour la feuille 1, j'attaque la feuille 2, mais avec toute vos explications et vos liens je pense me débrouiller et ne plus vous embêter!

Mille merci pour votre aide si précieuse.
Heureux d'avoir découvert ce forum.

Cordialement.

Thibaut