filtre élaboré avec condition est-ce possible si on quoi faire

**jpvba** · 14/02/2020, 15h16

Bonjour a vous tous,

J'ai présentement un code que j'utilise assez fréquemment. Il n'est pas rapide lorsque je traite de nombreuse ligne. Je voudrais optimiser celui-ci afin de pouvoir gagner du temps et éviter les plantages de excel. Mon réflexe pour optimiser celui si serais de faire un filtre élaboré, étant donné que je prend les donnés d'une page et copie certaines information dans une autre.

Il y a deux raisons que je ne fais pas de filtre élaboré c'est que je copie les données selon quelques conditions et que je veux garder l'ordonnancement des lignes. Si je fais plusieurs filtre élaboré et que je regroupe les résultats, je risque de perdre l'ordonnancement.

Est-ce que vous avez des suggestions ou des pistes afin de pouvoir m'aider, ça serais plus qu'apprécié. A titre indicatif, j'ai traité un dossier auquel j'avais presque 900 lignes et le code a pris 15 minute a exécuter.

Voici donc le code en question

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
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
Sub copiedansproduit_item_creation()
 
    Dim x As Integer
    Dim cell As Variant
    Dim LettreVoulue As String
    Dim LettreFormat As String
    Dim LettreFamille As String
    Dim LettreClasse As String
    Dim LettreGroupe As String
    Dim LettreSousGroupe As String
    Dim tout_Format As Range
    Dim tout_Famille As Range
    Dim tout_Classe As Range
    Dim tout_Groupe As Range
    Dim tout_SousGroupe As Range
    Dim element As Variant
 
    LettreVoulue = TrouveLettreColonne([prov_long_travail])
    LettreFormat = TrouveLettreColonne([no_format_travail])
    LettreFamille = TrouveLettreColonne([f_travail])
    LettreClasse = TrouveLettreColonne([c_travail])
    LettreGroupe = TrouveLettreColonne([g_travail])
    LettreSousGroupe = TrouveLettreColonne([sg_travail])
 
    Set tout_Format = Worksheets("Travail").Range(LettreFormat & 2, LettreFormat & LastLignUsedInColumn(LettreFormat))
    Set tout_Famille = Worksheets("Travail").Range(LettreFamille & 2, LettreFamille & LastLignUsedInColumn(LettreFamille))
    Set tout_Classe = Worksheets("Travail").Range(LettreClasse & 2, LettreClasse & LastLignUsedInColumn(LettreClasse))
    Set tout_Groupe = Worksheets("Travail").Range(LettreGroupe & 2, LettreGroupe & LastLignUsedInColumn(LettreGroupe))
    Set tout_SousGroupe = Worksheets("Travail").Range(LettreSousGroupe & 2, LettreSousGroupe & LastLignUsedInColumn(LettreSousGroupe))
 
 
 
    Application.ScreenUpdating = False
 
'nettoyer les lignes critiques afin d'enlever les caractères spéciaux
 
For Each element In Union(tout_Classe, tout_Famille, tout_Format, tout_Groupe, tout_SousGroupe)
 
element.Value = CleanTrim(CStr(element.Value))
 
Next element
 
 
'enlever les lignes de produit_item si jamais on refais la macro
 
    Worksheets("produits_items").Range("a2:BZ" & LastLignUsedInSheet("produits_items") + 1).Delete
 
 
    Sheets("Travail").Select
 
 
   For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
 
    If IsEmpty(Cells(x + 1, [no_item_travail].Column).Value) Then
 
' Si la couleur n'est pas un numéro ou le format n'est lui non plus un numéro ou
' si la provinciale courte est vide ou est égale a "???" ou le GAC ayant description régionale est vide ou est égale a "???"
' ou la provinciale longue est supérieur a 200 caractères ou la provinciale courte est supérieur a 100 caractères
' ou la famille classe groupe sous-groupe n'existe pas ou si le GAC ayant description régionale est ano ou gaceq ou sigma ou ??? et que la
' description régionale longue est supérieur de 200 et la courte supérieur a 100 et que le GAC ayant description courte est différent des choix
' possibles on indique un erreur et on quitte la sub
 
        If IsNumeric(Cells(x + 1, [no_couleur_travail].Column)) = False _
        Or IsNumeric(Cells(x + 1, [no_format_travail].Column)) = False _
        Or IsEmpty(Cells(x + 1, [no_format_travail].Column)) _
        Or IsEmpty(Cells(x + 1, [prov_court_travail].Column)) _
        Or Cells(x + 1, [prov_court_travail].Column) = "???" _
        Or IsEmpty(Cells(x + 1, [gac_travail].Column)) _
        Or Cells(x + 1, [gac_travail].Column) = "???" _
        Or Len(Cells(x + 1, [prov_long_travail].Column)) > 200 _
        Or Len(Cells(x + 1, [prov_court_travail].Column)) > 100 _
        Or Cells(x + 1, [fcgs_travail].Column) = "non" _
        Or ((UCase(Cells(x + 1, [gac_travail].Column).Value) = "SIGMA" _
        Or UCase(Cells(x + 1, [gac_travail].Column).Value) = "GACEQ" _
        Or UCase(Cells(x + 1, [gac_travail].Column).Value) = "ANO") _
        And (Cells(x + 1, [reg_long_travail].Column) = "???" _
        Or IsEmpty(Cells(x + 1, [reg_long_travail].Column)) _
        Or Len(Cells(x + 1, [reg_long_travail].Column)) > 200 _
        Or Cells(x + 1, [reg_court_travail].Column) = "???" _
        Or IsEmpty(Cells(x + 1, [reg_court_travail].Column)) Or Len(Cells(x + 1, [reg_court_travail].Column)) > 100)) _
        Or (UCase(Cells(x + 1, [gac_travail].Column).Value) <> "GACEQ" _
        And UCase(Cells(x + 1, [gac_travail].Column).Value) <> "SIGMA" _
        And UCase(Cells(x + 1, [gac_travail].Column).Value) <> "TOUS" _
        And UCase(Cells(x + 1, [gac_travail].Column).Value) <> "ANO" _
        And UCase(Cells(x + 1, [gac_travail].Column).Value) <> "AUCUN") Then
 
            MsgBox "N'a pu transféré dans l'onglet produit_item, utiliser le bouton validation a fin de trouver les erreurs !!!", vbCritical
            Exit Sub
 
        Else
 
        If IsEmpty(Cells(x + 1, [no_item_travail].Column).Value) Then
 
'copie description provinciale longue
 
            Sheets("produits_items").Cells(x + 1, [desc_prov_pi].Column) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
'copie description provinciale courte
 
            Sheets("produits_items").Cells(x + 1, [desc_prov_court_pi].Column) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
'mettre vrai dans index des taxes
 
      Union(Sheets("produits_items").Cells(x + 1, [ind_tx_prov_pi].Column), _
            Sheets("produits_items").Cells(x + 1, [ind_taxe_fed_pi].Column)) = "TRUE"
 
 
'mettre P dans code_portee_produit et dans code_portee_item
 
       Union(Sheets("produits_items").Cells(x + 1, [code_portee_produit_pi].Column), _
             Sheets("produits_items").Cells(x + 1, [code_portee_item_pi].Column)) = "P"
 
'copie de la famille
 
            Sheets("produits_items").Cells(x + 1, [no_famille_pi].Column) = Sheets("Travail").Cells(x + 1, [f_travail].Column)
 
'copie de la classe
 
            Sheets("produits_items").Cells(x + 1, [no_classe_pi].Column) = Sheets("Travail").Cells(x + 1, [c_travail].Column)
 
'copie du groupe
 
            Sheets("produits_items").Cells(x + 1, [no_groupe_pi].Column) = Sheets("Travail").Cells(x + 1, [g_travail].Column)
 
'copie du sous-groupe
 
            Sheets("produits_items").Cells(x + 1, [no_ss_groupe_pi].Column) = Sheets("Travail").Cells(x + 1, [sg_travail].Column)
 
'copie du format
            remplacement_format
 
            Sheets("produits_items").Cells(x + 1, [no_format_pi].Column) = Sheets("Travail").Cells(x + 1, [no_format_travail].Column)
 
'copie de la couleur s'il y a lieu
 
            If Not IsEmpty(Sheets("Travail").Cells(x + 1, [no_couleur_travail].Column).Value) Then _
            Sheets("produits_items").Cells(x + 1, [no_couleur_pi].Column) = Sheets("Travail").Cells(x + 1, [no_couleur_travail].Column)
 
'copie de la regionale longue et courte dépendamment de la colonne GAC ayant description régionnale
 
            Sheets("Travail").Select
 
            If UCase(Cells(x + 1, [gac_travail].Column).Value) = "GACEQ" Then
 
'Si GACEQ copie régionale longue dans desc_reg_gaceq
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si GACEQ copie régionale courte dans desc_reg_court_gaceq
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
 
'Si GACEQ copie provinciale longue dans desc_reg_gacouest et desc_reg_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si GACEQ copie provinciale courte dans desc_reg_court_gacouest et desc_reg_court_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "ANO" Then
 
'Si ANO copie régionale longue dans desc_reg_gacouest
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si ANO copie régionale courte dans desc_reg_court_gacouest
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
'Si ANO copie provinciale longue dans desc_reg_gaceq et desc_reg_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si ANO copie provinciale courte dans desc_reg_court_gaceq et desc_reg_court_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "SIGMA" Then
 
'Si SIGMA copie régionale longue dans desc_reg_sigmasante
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si SIGMA copie régionale courte dans desc_reg_court_sigmasante
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
'Si SIGMA copie provinciale longue dans desc_reg_gaceq et desc_reg_gacouest
 
          Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
'Si SIGMA copie provinciale courte dans desc_reg_court_gaceq et desc_reg_court_gacouest
 
          Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "AUCUN" Then
 
'Si "aucun" copie provinciale longue dans desc_reg_gaceq, desc_reg_gacouest et desc_reg_sigmasante
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si "aucun" copie provinciale courte dans desc_reg_court_gaceq, desc_reg_court_gacouest et desc_reg_court_sigmasante
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
           ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "TOUS" Then
 
'Si TOUS copie régionale longue dans desc_reg_gacouest_pi, desc_reg_gaceq_pi, desc_reg_sigmasante_pi
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si TOUS copie régionale courte dans desc_reg_court_gaceq_pi,desc_reg_court_gacouest_pi,desc_reg_court_sigmasante_pi
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
 
            End If
 
'Si la famille copier est 80 mettre S sinon P dans code_type_produit
 
            Sheets("produits_items").Cells(x + 1, [code_type_produit_pi].Column).Value = _
            IIf(Sheets("produits_items").Cells(x + 1, [no_famille_pi].Column).Value = 80, "S", "P")
 
            End If
 
        End If
 
    End If
 
    Next cell
 
'enlever les lignes vides de la feuille produits_items
 
    Sheets("produits_items").Select
    Range("A2").EntireRow.Insert
    Range("b1:B" & LastLignUsedInColumn("B")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
 
'sauvegarder le document
    ActiveWorkbook.Save
 
End Sub

A titre indicatif et de précision: Ma feuille de début s'appelle Travail et certaines info sont copier dans produits_items. J,ai nommé les différente colonne avec le gestionnaire de nom. Avant de faire les différentes copies de données, je valide si les champs obligatoire sont présents et de longueur et structure auquel un logiciel importera les données

merci pour votre aide, je suis présentement dans un impasse qui dépasse mes connaissances actuel

**mat955** · 14/02/2020, 18h04

Bonjour,

Tu fais beaucoup d’opérations sur ta plage de cellule, ce qui peut demander beaucoup de temps à Excel.
Une piste pour améliorer significativement le temps d'exécution, c'est de transférer l'intégralité de tes données Excel dans une grande variable tableau, et de réaliser les traitements directement dans la variable tableau.
Une fois terminé, tu rebalances les données du tableau dans ton Excel.

Inconvénient : Ca t'oblige à adapter ton code.
Avantage : exécution beaucoup plus rapide.

Je t'encourage à lire ce paragraphe du tuto Silkyroad, qui annonce un temps d'exécution 20x plus rapide, tout de même.

**jpvba** · 14/02/2020, 19h00

Un gros merci Mat,

Je vais le lire attentivement et vous reviens si question ou nouveau dénouement

encore une fois un gros merci !!!!

**jpvba** · 14/02/2020, 20h07

ReBonjour,

Dans l'exemple de silkyroad (

)

Il y a quelquechose qui échappe a ma compréhension.

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
Exemple issu de la FAQ Excel
'http://excel.developpez.com/faq/?page=Cellule#TabCellulesVariant
'Auteur: Bidou
 
Dim Montab As Variant, cmpt1 As Long, cmpt2 As Long
 
Montab = Range("A1:J65535").Value
 
For cmpt1 = LBound(Montab, 1) To UBound(Montab, 1)
    For cmpt2 = LBound(Montab, 2) To UBound(Montab, 2)
        Montab(cmpt1, cmpt2) = Montab(cmpt1, cmpt2) * 2 + 3
    Next cmpt2
Next cmpt1
 
Range("A1:J65535").Value = Montab

Je ne comprends pas la signification de (Montab, 1) ... mon cerveau interprète le tout comme étant la première colonne du array sois la A
(Montab, 2) comme etant la deuxieme donc la lettre B

Donc la (Montab, 1) serais la colonne de rangé et (Montab, 2) comme les colonnes et non A et B ???

**boisgontierjacques** · 14/02/2020, 20h36

Bonsoir,

Le filtre élaboré avec formule permet de définir des conditions complexes (Recherche Google: Filtre élaboré formule)

Boisgontier

**jpvba** · 17/02/2020, 21h09

Bonjour a vous tous,

J'ai continuer avec la solution de mat955 avant d'essayé celle de monsieur boisgontier

J'ai commencé a remplacé mes plages par des array mais j'arrive a un mur

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
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
Sub test_copiedansproduit_item_creation()
 
    Dim x As Integer
    Dim cell As Variant
 
    Dim LettreItem_travail As String
    Dim LettreProv_long_travail As String
    Dim LettreProv_court_travail As String
    Dim LettreReg_long_travail As String
    Dim LettreReg_court_travail As String
    Dim LettreNo_couleur_travail As String
    Dim LettreGac_travail As String
    Dim LettreFcgs_travail As String
 
 
    Dim LettreVoulue As String
 
    Dim LettreFormat As String
    Dim LettreFamille As String
    Dim LettreClasse As String
    Dim LettreGroupe As String
    Dim LettreSousGroupe As String
    Dim tout_Format As Range
    Dim tout_Famille As Range
    Dim tout_Classe As Range
    Dim tout_Groupe As Range
    Dim tout_SousGroupe As Range
 
 
 
    Dim tout_Item_travail As Range
    Dim tout_Prov_long_travail As Range
    Dim tout_Prov_court_travail As Range
    Dim tout_Reg_long_travail As Range
    Dim tout_Reg_court_travail As Range
    Dim tout_No_couleur_travail As Range
    Dim tout_Gac_travail As Range
    Dim tout_fcgs_travail As Range
 
    Dim element As Variant
 
 
    Dim TabTout As Variant
 
 
 
    LettreItem_travail = TrouveLettreColonne([no_item_travail])
    LettreProv_long_travail = TrouveLettreColonne([prov_long_travail])
    LettreProv_court_travail = TrouveLettreColonne([prov_court_travail])
    LettreReg_long_travail = TrouveLettreColonne([reg_long_travail])
    LettreReg_court_travail = TrouveLettreColonne([reg_court_travail])
    LettreNo_couleur_travail = TrouveLettreColonne([no_couleur_travail])
    LettreGac_travail = TrouveLettreColonne([gac_travail])
    LettreFcgs_travail = TrouveLettreColonne([fcgs_travail])
 
 
    LettreVoulue = TrouveLettreColonne([prov_long_travail])
 
    LettreFormat = TrouveLettreColonne([no_format_travail])
    LettreFamille = TrouveLettreColonne([f_travail])
    LettreClasse = TrouveLettreColonne([c_travail])
    LettreGroupe = TrouveLettreColonne([g_travail])
    LettreSousGroupe = TrouveLettreColonne([sg_travail])
 
    Set tout_Format = Worksheets("Travail").Range(LettreFormat & 2, LettreFormat & LastLignUsedInColumn(LettreFormat))
    Set tout_Famille = Worksheets("Travail").Range(LettreFamille & 2, LettreFamille & LastLignUsedInColumn(LettreFamille))
    Set tout_Classe = Worksheets("Travail").Range(LettreClasse & 2, LettreClasse & LastLignUsedInColumn(LettreClasse))
    Set tout_Groupe = Worksheets("Travail").Range(LettreGroupe & 2, LettreGroupe & LastLignUsedInColumn(LettreGroupe))
    Set tout_SousGroupe = Worksheets("Travail").Range(LettreSousGroupe & 2, LettreSousGroupe & LastLignUsedInColumn(LettreSousGroupe))
 
    Set tout_Item_travail = Worksheets("Travail").Range(LettreItem_travail & 2, _
                            LettreItem_travail & LastLignUsedInColumn(LettreItem_travail))
 
    Set tout_Prov_long_travail = Worksheets("Travail").Range(LettreProv_long_travail & 2, _
                                 LettreProv_long_travail & LastLignUsedInColumn(LettreProv_long_travail))
 
    Set tout_Prov_court_travail = Worksheets("Travail").Range(LettreProv_court_travail & 2, _
                                  LettreProv_court_travail & LastLignUsedInColumn(LettreProv_court_travail))
 
    Set tout_Reg_long_travail = Worksheets("Travail").Range(LettreReg_long_travail & 2, _
                                LettreReg_long_travail & LastLignUsedInColumn(LettreReg_long_travail))
 
 
    Set tout_Reg_court_travail = Worksheets("Travail").Range(LettreReg_court_travail & 2, _
                                 LettreReg_court_travail & LastLignUsedInColumn(LettreReg_court_travail))
 
    Set tout_No_couleur_travail = Worksheets("Travail").Range(LettreNo_couleur_travail & 2, _
                                  LettreNo_couleur_travail & LastLignUsedInColumn(LettreNo_couleur_travail))
 
    Set tout_Gac_travail = Worksheets("Travail").Range(LettreGac_travail & 2, _
                           LettreGac_travail & LastLignUsedInColumn(LettreGac_travail))
 
    Set tout_fcgs_travail = Worksheets("Travail").Range(LettreFcgs_travail & 2, _
                           LettreFcgs_travail & LastLignUsedInColumn(LettreFcgs_travail))
 
 
 
    TabTout = Array(tout_Item_travail, tout_Prov_long_travail, tout_Prov_court_travail, tout_Reg_long_travail, _
                    tout_Reg_court_travail, tout_No_couleur_travail, tout_Format, tout_Famille, tout_Classe, _
                    tout_Groupe, tout_SousGroupe, tout_Gac_travail, tout_fcgs_travail)
 
 
    Application.ScreenUpdating = False
 
'nettoyer les lignes critiques afin d'enlever les caractères spéciaux
 
For Each element In Union(tout_Classe, tout_Famille, tout_Format, tout_Groupe, tout_SousGroupe)
 
element.Value = CleanTrim(CStr(element.Value))
 
Next element
 
 
'enlever les lignes de produit_item si jamais on refais la macro
 
    Worksheets("produits_items").Range("a2:BZ" & LastLignUsedInSheet("produits_items") + 1).Delete
 
 
    Sheets("Travail").Select
 
 
   For Each cell In TabTout(2)
 
 
 
 
    If IsEmpty(TabTout(1)) Then
 
' Si la couleur n'est pas un numéro ou le format n'est lui non plus un numéro ou
' si la provinciale courte est vide ou est égale a "???" ou le GAC ayant description régionale est vide ou est égale a "???"
' ou la provinciale longue est supérieur a 200 caractères ou la provinciale courte est supérieur a 100 caractères
' ou la famille classe groupe sous-groupe n'existe pas ou si le GAC ayant description régionale est ano ou gaceq ou sigma ou ??? et que la
' description régionale longue est supérieur de 200 et la courte supérieur a 100 et que le GAC ayant description courte est différent des choix
' possibles on indique un erreur et on quitte la sub
 
        If IsNumeric(TabTout(6)) = False _
        Or IsNumeric(TabTout(7)) = False _
        Or IsEmpty(TabTout(7)) _
        Or IsEmpty(TabTout(3)) _
        Or TabTout(3) = "???" _
        Or IsEmpty(TabTout(12)) _
        Or TabTout(12) = "???" _
        Or Len(TabTout(2)) > 200 _
        Or Len(TabTout(3)) > 100 _
        Or TabTout(13) = "non" _
        Or ((UCase(TabTout(12).Value) = "SIGMA" _
        Or UCase(TabTout(12)).Value) = "GACEQ" _
        Or UCase(TabTout(12).Value) = "ANO") _
        And (TabTout(4) = "???" _
        Or IsEmpty(TabTout(4)) _
        Or Len(TabTout(4) > 200 _
        Or TabTout(5) = "???" _
        Or IsEmpty(TabTout(5)) Or Len(TabTout(5)) > 100)) _
        Or (UCase(TabTout(12)) <> "GACEQ" _
        And UCase(TabTout(12)) <> "SIGMA" _
        And UCase(TabTout(12)) <> "TOUS" _
        And UCase(TabTout(12)) <> "ANO" _
        And UCase(TabTout(12))) Then
 
 
 
            MsgBox "N'a pu transféré dans l'onglet produit_item, utiliser le bouton validation a fin de trouver les erreurs !!!", vbCritical
            Exit Sub
 
        Else
 
        If IsEmpty(TabTout(1)) Then
 
'copie description provinciale longue
 
            Sheets("produits_items").Cells(x + 1, [desc_prov_pi].Column) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
'copie description provinciale courte
 
            Sheets("produits_items").Cells(x + 1, [desc_prov_court_pi].Column) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
'mettre vrai dans index des taxes
 
      Union(Sheets("produits_items").Cells(x + 1, [ind_tx_prov_pi].Column), _
            Sheets("produits_items").Cells(x + 1, [ind_taxe_fed_pi].Column)) = "TRUE"
 
 
'mettre P dans code_portee_produit et dans code_portee_item
 
       Union(Sheets("produits_items").Cells(x + 1, [code_portee_produit_pi].Column), _
             Sheets("produits_items").Cells(x + 1, [code_portee_item_pi].Column)) = "P"
 
'copie de la famille
 
            Sheets("produits_items").Cells(x + 1, [no_famille_pi].Column) = Sheets("Travail").Cells(x + 1, [f_travail].Column)
 
'copie de la classe
 
            Sheets("produits_items").Cells(x + 1, [no_classe_pi].Column) = Sheets("Travail").Cells(x + 1, [c_travail].Column)
 
'copie du groupe
 
            Sheets("produits_items").Cells(x + 1, [no_groupe_pi].Column) = Sheets("Travail").Cells(x + 1, [g_travail].Column)
 
'copie du sous-groupe
 
            Sheets("produits_items").Cells(x + 1, [no_ss_groupe_pi].Column) = Sheets("Travail").Cells(x + 1, [sg_travail].Column)
 
'copie du format
            remplacement_format
 
            Sheets("produits_items").Cells(x + 1, [no_format_pi].Column) = Sheets("Travail").Cells(x + 1, [no_format_travail].Column)
 
'copie de la couleur s'il y a lieu
 
            If Not IsEmpty(Sheets("Travail").Cells(x + 1, [no_couleur_travail].Column).Value) Then _
            Sheets("produits_items").Cells(x + 1, [no_couleur_pi].Column) = Sheets("Travail").Cells(x + 1, [no_couleur_travail].Column)
 
'copie de la regionale longue et courte dépendamment de la colonne GAC ayant description régionnale
 
            Sheets("Travail").Select
 
            If UCase(Cells(x + 1, [gac_travail].Column).Value) = "GACEQ" Then
 
'Si GACEQ copie régionale longue dans desc_reg_gaceq
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si GACEQ copie régionale courte dans desc_reg_court_gaceq
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
 
'Si GACEQ copie provinciale longue dans desc_reg_gacouest et desc_reg_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si GACEQ copie provinciale courte dans desc_reg_court_gacouest et desc_reg_court_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "ANO" Then
 
'Si ANO copie régionale longue dans desc_reg_gacouest
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si ANO copie régionale courte dans desc_reg_court_gacouest
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
'Si ANO copie provinciale longue dans desc_reg_gaceq et desc_reg_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si ANO copie provinciale courte dans desc_reg_court_gaceq et desc_reg_court_sigmasante
 
        Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
              Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "SIGMA" Then
 
'Si SIGMA copie régionale longue dans desc_reg_sigmasante
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si SIGMA copie régionale courte dans desc_reg_court_sigmasante
 
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
'Si SIGMA copie provinciale longue dans desc_reg_gaceq et desc_reg_gacouest
 
          Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
'Si SIGMA copie provinciale courte dans desc_reg_court_gaceq et desc_reg_court_gacouest
 
          Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
            ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "AUCUN" Then
 
'Si "aucun" copie provinciale longue dans desc_reg_gaceq, desc_reg_gacouest et desc_reg_sigmasante
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_long_travail].Column)
 
 
'Si "aucun" copie provinciale courte dans desc_reg_court_gaceq, desc_reg_court_gacouest et desc_reg_court_sigmasante
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [prov_court_travail].Column)
 
 
           ElseIf UCase(Cells(x + 1, [gac_travail].Column).Value) = "TOUS" Then
 
'Si TOUS copie régionale longue dans desc_reg_gacouest_pi, desc_reg_gaceq_pi, desc_reg_sigmasante_pi
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [reg_long_travail].Column)
 
'Si TOUS copie régionale courte dans desc_reg_court_gaceq_pi,desc_reg_court_gacouest_pi,desc_reg_court_sigmasante_pi
 
           Union(Sheets("produits_items").Cells(x + 1, [desc_reg_court_gacouest_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_gaceq_pi].Column), _
                 Sheets("produits_items").Cells(x + 1, [desc_reg_court_sigmasante_pi].Column)) = Sheets("Travail").Cells(x + 1, [reg_court_travail].Column)
 
 
            End If
 
'Si la famille copier est 80 mettre S sinon P dans code_type_produit
 
            Sheets("produits_items").Cells(x + 1, [code_type_produit_pi].Column).Value = _
            IIf(Sheets("produits_items").Cells(x + 1, [no_famille_pi].Column).Value = 80, "S", "P")
 
            End If
 
        End If
 
    End If
 
    Next cell
 
'enlever les lignes vides de la feuille produits_items
 
    Sheets("produits_items").Select
    Range("A2").EntireRow.Insert
    Range("b1:B" & LastLignUsedInColumn("B")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
 
'sauvegarder le document
    ActiveWorkbook.Save
 
End Sub

Après mon For each cell j'ai mon If qui est le premier élément de mon array TabTout ... mais je e sais pas comment seulement ciblé la colonne ou la rangée, un peu ce que j'ai essayé d'expliquer dans le commentaire auquel je faisais référence au document de silkyroad ...

je vais donc essayé la méthode de monsieur boisgontier en attendant votre réponse.

en vous remerciant !!!

filtre élaboré avec condition est-ce possible si on quoi faire [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager