[VBA E] Problème de boucles - Structure de code

**proutfailelap1** · 28/03/2007, 22h50

Bonjour,

Je cherche à automatiser le traitement d'information sous Excel grâce au VBA.
Je m'y suis donc mis pour l'occasion, et j'ai créé le code ci-dessous. Celui-ci doit être totalement "non optimisé", voire aberrant pour des habitués de la programmation. Soyez donc indulgent avec moi !

Ma priorité est que ce code marche. Je le retravaillerai ensuite pour qu’il soit optimisé. Je suis donc ouvert à toutes remarques/suggestions pour ce dernier point.

Mais j'ai un problème avec le code que j'ai créé :

Ce morceau de code utilise les onglets "NEW_AD", "REFEX" et "Liste E". Le but est d'insérer dans l'onglet "Liste E" certaines lignes. J'ai fait des boucles dans des boucles, j'avoue que me suis un peu perdu. Le traitement se lance bien, mais j'ai l'impression que l'incrémentation ne se fait pas, qu'il traite toujours la même ligne.

Pouvez-vous m'aider ?
Je joins le fichier excel avec le code complet si ça peut vous aider.

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
 
Private Sub CommandButton5_Click()
 
Dim colonneADVid
Dim ligneADVid
Dim colonneRefVid
Dim ligneRefVid
Dim ligneAD
Dim ligneADNew
Dim ligneRef
Dim idAD
Dim idADE
Dim idCompl
Dim idRefex
Dim idNew
 
 
'''''''' Repère la fin des données de la feuille NEW_AD
Sheets("NEW_AD").Select
ActiveSheet.Range("C2").Select
While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Activate
    colonneADVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
    ligneADVid = ActiveCell.Row
Wend
 
'''''''' Repère la fin des données de la feuille REFEX
Sheets("REFEX").Select
ActiveSheet.Range("B2").Select
While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Activate
    colonneRefVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
    ligneRefVid = ActiveCell.Row
Wend
 
'''''''' Place les valeurs correspondantes dans la feuille Liste E
ligneAD = 2
ligneADNew = 2
ligneRef = 2
'''''''' Tant qu'on arrive pas à la fin des données de la feuille NEW_AD
While ligneAD < ligneADVid
   Sheets("NEW_AD").Select
   idAD = ActiveSheet.Range("C" & ligneAD).Value
   idADE = Left(idAD, 1)
'''''''' Vérifie si le premier caractère est un chiffre
   If IsNumeric(idADE) Then
'''''''' Boucle tant qu'on arrive pas à la fin des données de l'onglet REFEX
        Do Until ligneRef = ligneRefVid + 1
            Sheets("NEW_AD").Select
            idCompl = ActiveSheet.Range("D" & ligneAD).Value
            Sheets("REFEX").Select
            idRefex = ActiveSheet.Range("C" & ligneAD).Value
            If idCompl = idRefex Then
               Sheets("NEW_AD").Select    
               ActiveSheet.Range("A" & ligneAD).Select
                Selection.Copy
                Sheets("Liste Echus").Select
                ActiveSheet.Range("A" & ligneADNew).PasteSpecial
                Sheets("NEW_AD").Select
 
                ActiveSheet.Range("B" & ligneAD).Select
                Selection.Copy
                Sheets("Liste Echus").Select
                ActiveSheet.Range("B" & ligneADNew).PasteSpecial
                Sheets("NEW_AD").Select
 
                ActiveSheet.Range("C" & ligneAD).Select
                Selection.Copy
                Sheets("Liste Echus").Select
                ActiveSheet.Range("C" & ligneADNew).PasteSpecial
                Sheets("NEW_AD").Select
 
                ligneADNew = ligneADNew + 1
                ligneRef = 2
                Exit Do
            End If
        ligneRef = ligneRef + 1
        Loop
   End If
   ligneAD = ligneAD + 1
Wend
 
End Sub

Même combat pour ce bout de code :

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
Private Sub CommandButton3_Click()
 
Dim colonneADVid
Dim ligneADVid
Dim colonneHierVid
Dim ligneHierVid
Dim colonneLocVid
Dim ligneLocVid
Dim tableauChaine() As String
Dim finTableau
Dim ligneM
Dim ligneHier
Dim ligneHierTemp
Dim ligneLoc
Dim ligneAD
Dim nompreAD
Dim nomAD
Dim preAD
Dim nomHier
Dim preHier
Dim nomLocal
 
 
Sheets("AD").Select
ActiveSheet.Range("B2").Select
 
' Repère la première cellule vide de la feuille AD
While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Activate
    colonneADVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
    ligneADVid = ActiveCell.Row
Wend
 
' Repère la première cellule vide de la feuille A_HIERAR
 Sheets("A_HIERAR").Select
 ActiveSheet.Range("B2").Select
 While IsEmpty(ActiveCell) = False
     ActiveCell.Offset(1, 0).Activate
     colonneHierVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
     ligneHierVid = ActiveCell.Row
 Wend
 
' Repère la première cellule vide de la feuille A_LOCAL
 Sheets("A_LOCAL").Select
 ActiveSheet.Range("B2").Select
 While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Activate
    colonneLocVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
    ligneLocVid = ActiveCell.Row
 Wend
 
 
' Place les valeurs correspondantes dans la feuille Liste M en fonction des données de la feuille A_HIERAR
ligneAD = 2
ligneM = 2
ligneHier = 2
ligneLoc = 2
 
While ligneAD < ligneADVid
   Sheets("AD").Select
   nompreAD = ActiveSheet.Range("C" & ligneAD).Value
 
   If nompreAD = "" Then
        ActiveSheet.Range("C" & ligneAD).Value = "Case1 Case2 Case3"
        nompreAD = ActiveSheet.Range("C" & ligneAD).Value
   End If
 
   tableauChaine = Split(nompreAD, " ")
   nomAD = tableauChaine(0)
   preAD = tableauChaine(1)
   If UBound(tableauChaine) > 1 Then
        Do Until ligneHier = ligneHierVid
            Sheets("A_HIERAR").Select
            nomHier = ActiveSheet.Range("B" & ligneHier).Value
            preHier = ActiveSheet.Range("C" & ligneHier).Value
            If nomAD = nomHier Then
                If preAD = preHier Then
                      Sheets("AD").Select
 
                      ActiveSheet.Range("B" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("A" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Range("C" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("B" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Range("D" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("C" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Rows(ActiveCell.Row).EntireRow.Delete
                      ligneHier = 2
                      ligneM = ligneM + 1
                End If
                Else
                ligneHier = ligneHier + 1
            End If
        Loop
        ligneAD = ligneAD + 1
    Else
        ligneAD = ligneAD + 1
   End If
Wend
 
' Repère la première cellule vide de la feuille AD
Sheets("AD").Select
ActiveSheet.Range("C2").Select
 
While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Activate
    colonneADVid = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
    ligneADVid = ActiveCell.Row
Wend
 
' Place les valeurs correspondantes dans la feuille Liste M en fonction des données de la feuille A_LOCAL
ligneAD = 2
ligneM = 2
ligneHier = 2
ligneLoc = 2
 
While ligneAD < ligneADVid
   Sheets("AD").Select
   nompreAD = ActiveSheet.Range("C" & ligneAD).Value
   tableauChaine = Split(nompreAD, " ")
   nomAD = tableauChaine(0)
   preAD = tableauChaine(1)
   If UBound(tableauChaine) > 1 Then
        Do Until ligneHier = ligneHierVid
            Sheets("A_LOCAL").Select
            nomHier = ActiveSheet.Range("A" & ligneHier).Value
            preHier = ActiveSheet.Range("B" & ligneHier).Value
            If nomAD = nomHier Then
                If preAD = preHier Then
                      Sheets("AD").Select
 
                      ActiveSheet.Range("B" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("A" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Range("C" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("B" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Range("D" & ligneAD).Select
                      Selection.Copy
                      Sheets("Liste M").Select
                      ActiveSheet.Range("C" & ligneM).PasteSpecial
                      Sheets("AD").Select
 
                      ActiveSheet.Rows(ActiveCell.Row).EntireRow.Delete
                      ligneHier = 2
                      ligneM = ligneM + 1
                Else
                    ligneHier = ligneHier + 1
                End If
            Else
            ligneHier = ligneHier + 1
            End If
        Loop
        ligneAD = ligneAD + 1
   Else
        ligneAD = ligneAD + 1
   End If
Wend
 
End Sub

Merci par avance.
Bruno.

[VBA E] Problème de boucles - Structure de code

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager