[XL-2007] Parcourir les lignes d'une partie du classeur

[johan89]

Bonjour,

J'ai besoin de parcourir les lignes d'un classeur excel jusqu'à ce qu'une ligne vide apparaisse, puis, de comparer des cellules entre elles.

Par exemple, je commence par la ligne 1, et je veux sélectionner une cellule de cette ligne, puis la comparer. Ainsi de suite, jusqu'à tomber sur une ligne vide.

Comment faire pour parcourir les lignes et sélectionner une cellule parmi la ligne actuelle ?

Merci d'avance

[gigalia]

Bonjour,

Tu veux la comparer avec quoi ta cellule?

Sincères salutations.

[johan89]

Salut

Simplement avec un nombre.
Concrètement, c'est
si <cellule> = "000" alors <cellule d'un autre classeur> = "658045"
sinon <cellule d'un autre classeur> = "625110"

[patricktoulon]

bonjour

n'ayant pas plus de renseignements sur le 2eme classeur

je t'ai fait une base

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
 
Sub truc_machin()
'on determine d'abors  la derniere ligne absolu renseignée comme ceci
    Dim DerniereLigne As Long
    Dim DerniereColonne As Long
   dim ligne as long,col as long
 
 Dim le_chiffre As Long
    DerniereLigne = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    'je rappelle que tu a ca dans la faq
    'bien on a maintenant le nombre de lignes  renseignée dans le sheet
    'maintenant on va boucler sur toute les lignes et a chaque ligne boucler sur toute les colonne de la ligne qui sont renseignée
    For ligne = 1 To DerniereLigne
        'on compte le nombre de colonne de la ligne "i"
        DerniereColonne = Range("A" & i).End(xlToRight).Column
        'on imbrique maintenant dans la boucle des collonnes celle des lignes 
        For col = 1 To DerniereColonne
            'et maintenant on pose la question
            If Cells(ligne, col) = "000" Then
                le_chiffre = 658045
           'ici tu na cas metre le traitement sur l'autre classeur en fonction  de "le_chiffre"
 
 Else
                le_chiffre = 625110
    'ici tu na cas metre le traitement sur l'autre classeur en fonction  de "le_chiffre "       
 End If
        Next col
    Next ligne
End Sub

[johan89]

Merci de m'avoir donné les bonnes bases. Je l'adapte à mon code et je poste mon code

J'ai un problème au niveau de la comparaison du nombre sur lequel je butte depuis une bonne heure : lorsqu'il s'agit de "000", il ne reconnaît pas et il ne rempli pas la cellule correctement. Il faut savoir que dans la cellule d'origine, c'est noté '000 dans la barre de formule. Mais même en modifiant le format, il n'y a pas moyen, ça ne fonctionne pas. Même en mettant un .Value après le Cell.

Puis, j'aimerai comprendre aussi pourquoi dès que l'on ouvre un nouveau classeur (Classeur1), puis qu'on le ferme, puis qu'on ouvre un autre classeur, ce dernier se nomme Classeur2 ? Je perds beaucoup de temps lors de mes tests en devant fermer à chaque fois le fichier de base pour que le nouveau classeur que j'ouvre dans mon code se nomme Classeur1.

[patricktoulon]

bonjour

tu dis dans ton message que si c'est "000" c'est "658045"
autrement c'est 625110 mais tu dis pas la destination des cellules de l'autre classeur

dis moi exactement les nom les adresse et je vais voir ce que je peux faire


au plaisir

[johan89]

Bonsoir Patrick,

Je te mets mon code actuel :

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
Sub generation_fichier_output()
 
'Copie du tableau pré-rempli dans le fichier output généré, à partir du deuxième onglet (input) à cacher
    Dim varTxt As String
    Dim varTour As Long
    varTour = 1
 
    Workbooks.Add
    Windows("Prototype Input.xls").Activate
    Sheets("Prototype Output").Select
    Cells.Select
    Selection.Copy
    Windows("Classeur1").Activate
    Cells.Select
    ActiveSheet.Paste
    Range("A14").Select
    Application.CutCopyMode = False
'ChDir "C:\Users\champagj\Desktop"
'ActiveWorkbook.SaveAs Filename:="C:\Users\champagj\Desktop\Output.xls", _
'    FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
'    ReadOnlyRecommended:=False, CreateBackup:=False
 
'Remplissage nature comptable (Output)
'on determine d'abors  la derniere ligne absolu renseignée comme ceci
    Dim DerniereLigne As Long
    Dim DerniereColonne As Long
    Dim ligne As Long, col As Long
    Dim nature_comptable As Long
    Dim ligne_dest As Long
    Dim test_valeur As Long
 
 
    Windows("Prototype Input.xls").Activate
'Déterminer nombre de ligne
    DerniereLigne = Sheets("Prototype Input").Range("A1").SpecialCells(xlCellTypeLastCell).Row
 
'Parcoure toutes les lignes qui nous intéressent de l'input
    For ligne = 7 To DerniereLigne
        Sheets("Prototype Input").Activate
        If Cells(ligne, 29) = "0000" Then
            nature_comptable = 658045
            Windows("Classeur1").Activate 'output
            Cells(ligne, 1).Value = nature_comptable
            Windows("Prototype Input.xls").Activate 'input
        Else
            nature_comptable = 625110
            Windows("Classeur1").Activate 'output
            ligne_dest = ligne - 5 'règle décalage entre les 2 fichiers
            Cells(ligne_dest, 1).Value = nature_comptable
            Windows("Prototype Input.xls").Activate 'input
 
            test_valeur = Cells(ligne, 29).Value
            MsgBox (test_valeur)
        End If
    Next ligne
    MsgBox (DerniereLigne)
End Sub

L'idée c'est de créer un nouveau classeur en cliquant sur le bouton de celui de base, puis d'y copier tout un "prototype" qui est présent dans le second onglet de la feuille de base (que je vais cacher par la suite) dans un premier temps. Ce prototype représente un tableau avec des champs. Pour cela, j'ai utilisé un collage par liaison. Pour générer une partie du code, j'ai utilisé l'option "Enregistrer une macro" : donc j'ai fais les actions et la macro s'est créée.

Après, il faut que j'aille plus en détail en faisant tout d'abord la comparaison dont je te parle pour remplir les champs du classeur crée. Mais lorsque je rencontre "0000" (oui c'est 4 zéros et pas trois), le champs du second classeur reste vide.

Puis j'ai l'histoire de "Classeur1" "Classeur2" qui est assez pénible pour faire les tests.

Je te mets en pièce jointe le fichier qui, en cliquant sur "Bouton 1" après l'avoir ouvert, génère l'autre fichier.

Merci pour ton aide en tout cas, c'est très sympa. On revoit ça demain

[johan89]

Bonjour !

Je suis arrivé après quelques jours à avoir un résultat. Je poste l'état de mon code actuel :

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
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
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
Sub quadrillage_output()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
 
Sub main()
 
'Masque rafraichissement fenêtre
    Application.ScreenUpdating = False
 
'Copie du tableau pré-rempli dans le fichier output généré, à partir du deuxième onglet (input) à cacher
    Dim varTxt As String
    Dim varTour As Long
    varTour = 1
 
    Windows("Prototype Input Essilor.xls").Activate
    Sheets("Prototype Output").Visible = False
    Workbooks.Add
    Application.DisplayAlerts = False 'Messages désactivés
    ActiveWorkbook.SaveAs Filename:="C:\Citi.xls", _
    FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Windows("Prototype Input Essilor.xls").Activate
    Sheets("Prototype Output").Visible = True
    Sheets("Prototype Output").Select
    Rows("1:1").Select
    Selection.Copy
    Windows("Citi.xls").Activate
    Rows("1:1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    Windows("Prototype Input Essilor.xls").Activate
    Sheets("Prototype Output").Visible = False
 
'Application.DisplayStatusBar = True
'Application.StatusBar = "Traitement en cours..."
'MsgBox "Génération du fichier en cours"
 
'Déterminer nombre de Ligne
    Dim DerniereLigne As Long
    Windows("Prototype Input Essilor.xls").Activate
    DerniereLigne = Sheets("Prototype Input").Range("A1").SpecialCells(xlCellTypeLastCell).Row
'MsgBox (DerniereLigne)
 
 
'Parcoure toutes les Lignes qui nous intéressent de l'input
    Dim Ligne As Long
    Dim LigneOutput As Long
    Dim Colonne
    Dim NatureComptable1
    Dim NatureComptable2
    NatureComptable1 = 658045
    NatureComptable2 = 625110
    Dim Credit
    Dim TotalDebit
    Dim TotalCredit
    Dim TotalMontantTTC
    TotalDebit = 0
    TotalCredit = 0
    TotalMontantTTC = 0
    Dim colB
    Dim colN
    Dim colBF
    Dim colBE
    Dim LastLine
    Dim Res
    Dim ResCredit
    Dim ApresDerniereLigne
 
    For Ligne = 7 To DerniereLigne
        LigneOutput = Ligne - 5 'règle décalage entre les 2 fichiers
 
'Quadrillage output
        For Colonne = 1 To 17
            Windows("Citi.xls").Activate
            Cells(LigneOutput, Colonne).Select
            Call quadrillage_output
            Next Colonne
 
'Nature comptable
Windows("Prototype Input Essilor.xls").Activate
Sheets("Prototype Input").Select
 
If Cells(Ligne, 29).Value <> "0000" Then
Windows("Citi.xls").Activate
Cells(LigneOutput, 1).Value = NatureComptable2
Else
Windows("Citi.xls").Activate
Cells(LigneOutput, 1).Value = NatureComptable1
End If
 
'Section
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 29).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 2).Select
            ActiveSheet.Paste Link:=True
 
'Projet
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 3).Value = "'0000"
 
'Interco
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 4).Value = "'0000000"
 
'Debit
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
 
            If Cells(Ligne, 77).Value >= 0 Then
                Windows("Prototype Input Essilor.xls").Activate
                Sheets("Prototype Input").Select
                TotalDebit = TotalDebit + Cells(Ligne, 77).Value
                Cells(Ligne, 77).Select
                Selection.Copy
                Windows("Citi.xls").Activate
                Cells(LigneOutput, 5).Select
                ActiveSheet.Paste Link:=True
            End If
'MsgBox (TotalDebit)
 
'Credit
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            If Cells(Ligne, 77).Value < 0 Then
                Windows("Prototype Input Essilor.xls").Activate
                Sheets("Prototype Input").Select
                Credit = Cells(Ligne, 77) * -1
                TotalCredit = TotalCredit + Credit
                Windows("Citi.xls").Activate
                Cells(LigneOutput, 6).Value = Credit
            End If
'MsgBox (TotalCredit)
 
 
'Libelle
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            colB = Cells(Ligne, 2).Value
            colN = Cells(Ligne, 14).Value
            colBF = Cells(Ligne, 58).Value
            colBE = Cells(Ligne, 56).Value
 
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 7).Value = "CARTE LOGEE : NUM. FACT : " + colB + " - BENEF : " + colN + " - DATE VOYAGE : " + colBF + " - DEST : " + colBE
 
'Montant TTC
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            TotalMontantTTC = TotalMontantTTC + Cells(Ligne, 77).Value
            Cells(Ligne, 77).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 8).Select
            ActiveSheet.Paste Link:=True
 
'Num de facture
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 2).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 11).Select
            ActiveSheet.Paste Link:=True
 
'Beneficiaire
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 14).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 12).Select
            ActiveSheet.Paste Link:=True
 
'Date Voyage
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 58).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 13).Select
            ActiveSheet.Paste Link:=True
 
'Destination
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 57).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 14).Select
            ActiveSheet.Paste Link:=True
 
'Nom fournisseur
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 10).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 15).Select
            ActiveSheet.Paste Link:=True
 
'Montant TVA
            Windows("Prototype Input Essilor.xls").Activate
            Sheets("Prototype Input").Select
            Cells(Ligne, 72).Select
            Selection.Copy
            Windows("Citi.xls").Activate
            Cells(LigneOutput, 17).Select
            ActiveSheet.Paste Link:=True
 
            Next Ligne
' MsgBox (DerniereLigne)
 
'Derniere Ligne
            LastLine = LigneOutput + 1
 
'Quadrillage + Remplissage dernière ligne
            For Colonne = 1 To 17
                Windows("Citi.xls").Activate
                Cells(LastLine, Colonne).Select
                Call quadrillage_output
                Next Colonne
 
                Windows("Citi.xls").Activate
                Cells(LastLine, 1).Value = "625110"
                Cells(LastLine, 2).Value = "7000"
                Cells(LastLine, 3).Value = "'0000"
                Cells(LastLine, 4).Value = "'0000000"
 
                Res = TotalCredit - TotalDebit
'MsgBox(Res)
                If Res >= 0 Then
                    Cells(LastLine, 6).Value = Res
                End If
 
                If Res < 0 Then
                    ResCredit = (-1) * Res
                    Cells(LastLine, 5).Value = ResCredit
                End If
 
                Cells(LastLine, 7).Value = "FNP CARTE LOGEE"
                Cells(LastLine, 8).Value = TotalMontantTTC
 
 
 
'Redimensionnement colonnes
                Columns("A:A").EntireColumn.AutoFit
                Columns("B:B").EntireColumn.AutoFit
                Columns("C:C").EntireColumn.AutoFit
                Columns("D:D").EntireColumn.AutoFit
                Columns("E:E").EntireColumn.AutoFit
                Columns("F:F").EntireColumn.AutoFit
                Columns("G:G").EntireColumn.AutoFit
                Columns("H:H").EntireColumn.AutoFit
                Columns("I:I").EntireColumn.AutoFit
                Columns("J:J").EntireColumn.AutoFit
                Columns("K:K").EntireColumn.AutoFit
                Columns("L:L").EntireColumn.AutoFit
                Columns("M:M").EntireColumn.AutoFit
                Columns("N:N").EntireColumn.AutoFit
                Columns("O:O").EntireColumn.AutoFit
                Columns("P:P").EntireColumn.AutoFit
                Columns("Q:Q").EntireColumn.AutoFit
 
'Gras autour de première et dernière ligne
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                Range("A1:Q1").Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                Range(Cells(LastLine, 1), Cells(LastLine, 17)).Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
 
                Application.ScreenUpdating = True
'Application.DisplayStatusBar = False
 
'Enregistrement
                Windows("Citi.xls").Activate
                ActiveWorkbook.SaveAs Filename:="C:\Citi.xls", _
                FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
 
'Placement curseur fin
                Windows("Citi.xls").Activate
                ApresDerniereLigne = DerniereLigne - 3
                Cells(ApresDerniereLigne, 1).Select
 
                MsgBox ("Enregistré :) ")
 
            End Sub

Tout fonctionne, cependant, comme je ne suis pas un pro en VBA, j'aimerai savoir si on peut optimiser ce code (je pense que oui !!).
Aussi, comme le temps de la macro augmente rapidement avec le nombre de ligne du fichier source (sans doute dû à mon codage en carton lol), j'aimerai ajouter un message pour avertir l'utilisateur.
J'ai cherché, apparement, les MsgBox silencieuse n'héxistent pas. Après, j'ai cherché pour mettre une barre de progression, mais je n'arrive pas à mettre en place cela. Je suis tombé sur tout type de solutions. Je ne sais pas où placer le code Pouvez-vous m'aider à finaliser ma macro svp ? Merci