VBA - valeur d'intersection

Version imprimable

18/01/2010, 16h18
p0l1n

1 pièce(s) jointe(s)

VBA - Feuille Suivi vacances dynamique

Bonjour, je suis nouveau sur ce forum et je le trouve super !

Après plusieurs essais je crois avoir trouvé une méthode pour faire exactement ce que je voulais au départ.

Voici donc un exemple de mon projet et je vous le met disponible si vous voulez adapter à vos besoins.

Ce tableur de suivi de surtemps ce met à jour en remplissant la feuille de temps directement et les positionne dans une feuille de suivi tout dépendant du code vacance entré dans la feuille de temps.

J'ai rechercher de nombreuses heures sur la toile pour trouver un exemple qui ressemblait un peu à ceci et je n'ai jamais rien trouvé.

Donc si vous aviez le même problème que moi j'espère que je vous aurai aider un peu à atteindre votre objectif.

Oui il y a beaucoup de code... mais je n'ai pas les connaissances pour le simplifier... c'est pourquoi je ne met pas le sujet en Résolu =P

Bonne journée le forum !

Bonjour,
ci-joint un petit fichier exemple (j'ai scindé en 2feuilles)
et le code correspondant

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
Private Sub CommandButton1_Click()
Dim LastLig As Long, NewLig As Long, Lig As Long
Dim NewCol As Integer, Col As Integer
Dim c As Range
 
LastLig = Cells(Rows.Count, 1).End(xlUp).Row
If LastLig > 1 Then
    With Sheets("Calendrier")
        NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        NewCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        Set c = .Columns("A:A").Find(Range("A" & LastLig).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            Lig = c.Row
        Else
            Lig = NewLig
            .Cells(Lig, 1).Value = Range("A" & LastLig).Value
        End If
        Set c = Nothing
 
        Set c = .Rows(1).Find(Range("C" & LastLig).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            Col = c.Column
        Else
            Col = NewCol
            .Cells(1, Col).Value = Range("C" & LastLig).Value
        End If
        Set c = Nothing
        .Cells(Lig, Col).Value = Range("B" & LastLig).Value
        .Cells(Lig, 2).FormulaR1C1 = "=sum(rc[1]:rc[" & Col - 2 & "])"
    End With
End If
End Sub

19/01/2010, 22h25
p0l1n

J'ai essayer ta solution, je crois que tu me donne une très bonne piste pour arriver à ce que je veux faire. Mais dans ton fichier calendrier, dans l'onglet Saisie, je dois entrer la date. Tandis que dans le projet que je monte, la date est déja inscrite dans le calendrier. D'où pourquoi je croyais pouvoir aller chercher le nbr. heure dans le tableau via la commande intersect....

De plus, si il y a plusieurs entrée seulement 1ligne est transféré... mais ton code me donne une bonne piste. Je crois être capable de l'adapter.

merci beaucoup le forum !

Simplification de code

Bon, j'ai réussi à faire ce que je veux, mais beaucoup de variables.... et ca me donne tout un mal de tête. Je voudrais savoir si il y a possibilité de simplifier ce code ? car comme je suis parti je dois le faire pour chacune des lignes de mon tableau....

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
'======================== Pour Transfert du 1er Bloc du Tableau de la Période ===========================
' Déclare Position de la Référence du Bloc
 
Set Bloc1 = Worksheets("Per1").Range("B110")
Set Bloc2 = Worksheets("Per1").Range("B125")
Set Bloc3 = Worksheets("Per1").Range("D140")
Set Bloc4 = Worksheets("Per1").Range("D155")
 
' Organise case Nbr.Heure
Set a = Worksheets("Per1").Range("D110") 'Valeur 1er ligne
Set b = Worksheets("Per1").Range("D111") 'Valeur 2e ligne
Set c = Worksheets("Per1").Range("D112") ' Valeur 3e Ligne
Set d = Worksheets("Per1").Range("D113") ' Valeur 4e Ligne
Set e = Worksheets("Per1").Range("D114") ' Valeur 5e Ligne
Set f = Worksheets("Per1").Range("D115") ' Valeur 6e Ligne
Set g = Worksheets("Per1").Range("D116") 'Valeur 7e ligne
Set h = Worksheets("Per1").Range("D117") 'Valeur 8e ligne
Set i = Worksheets("Per1").Range("D118") ' Valeur 9e Ligne
Set j = Worksheets("Per1").Range("D119") ' Valeur 10e Ligne
Set k = Worksheets("Per1").Range("D120") ' Valeur 11e Ligne
Set l = Worksheets("Per1").Range("D121") ' Valeur 12e Ligne
Set m = Worksheets("Per1").Range("D122") 'Valeur 13e ligne
Set n = Worksheets("Per1").Range("D123") 'Valeur 14e ligne
 
 
 
'Transfert de la Date et du Nbr.Heure dans tableau suivi Vacance seulement SI le nbr. d'Heure est plus grand que Zéro.
'la commande est répétitive pour chacune des lignes.
If Bloc1 = "4CCS" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C110").Value
ElseIf Bloc1 = "4MOB" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C110").Value
ElseIf Bloc1 = "4VNC" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C110").Value
ElseIf Bloc1 = "4PAY" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C110").Value
End If
End If
End If
End If
End If
 
'Ensuite ce bout de code devrait être répété pour chacune des variables qui correspond à une ligne de mon tableau " de a à n "
 
End Sub

Je sais que ce code n'est pas le plus beau, mais vu mes connaissances et ce qu'il arrive à faire je suis très fier de moi ! mais je suis sur et certain qu'il y a moyen de simplifier le tout.

merci encore tout le forum !

21/01/2010, 20h39
mercatog

Le code que je t'avais fourni fonctionne bien même si dans ta première ligne les date sont déjà renseignée!!
et même si une date est absente, elle la rajoute à la fin
21/01/2010, 22h10
p0l1n

oui. mais je voudrais que le tableau se remplise automatiquement tout dépendant de la feuille de temps de la personne.

J'ai mis en fichier attacher à quoi ressemble la feuille de temps. Le code temps que la personne entre peut être sur la 1er ligne comme sur la 21e, et le temps qu'il met peut être n'importe quel journée.

Donc j'utilise un tableau dynamique en B:108 pour placer les valeurs tout dépendant comment ils sont entré dans la feuille, mais leur position n'est jamais la même. Si je prend seulement 1code ou bien 4 dans la période, le tableau change de dimensions.

Mes explications ne sont peut-être pas clair, j'en suis désolé, mais je crois que je m'approche du but final.

** Attention le tableau ne se met pas à jour automatiquement, tu dois le faire manuellement, je ne sais pas comment encore, je n'ai pas vraiment rechercher.

Merci encore !
21/01/2010, 22h26
mercatog

Re bonsoir,
j'avoue que je n'ai rien compris d'autant plus la capture écran du post initial est différente.

Edit:

Ou bien, j'ai mal compris
j'ai fais la démarche inverse (peut être); du récap vers le calendrier (comme dans mon exemple)
alors qu'il fallait, du calendrier vers le récap
22/01/2010, 19h17
p0l1n

démarche inverse peut-être, mais c'Est ce qui ma ammener vers cette solution qui fait très bien ce que je veux, sauf que pas fonctionnel à 100%....

ma capture écran ne parlait pas vraiment jaurais du attacher mon classeur à mon poste, mais ton aide est extrêmement apprécié !
22/01/2010, 19h31
p0l1n

1 pièce(s) jointe(s)

avec ce code ca fonctionne nickel, mais il y a surement moyen de simplifier le tout, car pour l'instant seulement 3 codes différents peuvent être vérifier dans le tableau dynamique. Si je r'ajoute le code pour vérifier la 4e case du tableau, j'ai une erreur de code trop long....

Pour mon application je voudrai au minimum prendre 4 codes différent, mais surement 4-5 autres codes pourrait être ajouter...

le tableau dynamique ne se met toujours pas à jour automatiquement... j'aimerais bien, mais pas encore trouver comment =P

merci à tous pour votre aide

je crois avoir résolu mon problème de grosseur de routine, chaque recherche dans chacune des cases du tableau dynamique, maintenant elle est dans un module.

Dans la commande de mon bouton :

Code:

1
2
3
Call Bloc_1
Call Bloc_2
Call Bloc_3

et un module par bloc du tableau dynamique :

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
Sub Bloc_1()
 
Set Bloc1 = Worksheets("Per1").Range("B110")
 
'======================== Pour Transfert du 1er Bloc du Tableau de la Période ===========================
' Organise case Nbr.Heure du 1er bloc du tableau dynamique
Set a = Worksheets("Per1").Range("D110") 'Valeur 1er ligne
Set b = Worksheets("Per1").Range("D111") 'Valeur 2e ligne
Set c = Worksheets("Per1").Range("D112") ' Valeur 3e Ligne
Set d = Worksheets("Per1").Range("D113") ' Valeur 4e Ligne
Set e = Worksheets("Per1").Range("D114") ' Valeur 5e Ligne
Set f = Worksheets("Per1").Range("D115") ' Valeur 6e Ligne
Set g = Worksheets("Per1").Range("D116") 'Valeur 7e ligne
Set h = Worksheets("Per1").Range("D117") 'Valeur 8e ligne
Set i = Worksheets("Per1").Range("D118") ' Valeur 9e Ligne
Set j = Worksheets("Per1").Range("D119") ' Valeur 10e Ligne
Set k = Worksheets("Per1").Range("D120") ' Valeur 11e Ligne
Set l = Worksheets("Per1").Range("D121") ' Valeur 12e Ligne
Set m = Worksheets("Per1").Range("D122") 'Valeur 13e ligne
Set n = Worksheets("Per1").Range("D123") 'Valeur 14e ligne
 
 
'====================== 1er ligne ====================
If Bloc1 = "4CCS" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C110").Value
End If
End If
If Bloc1 = "4MOB" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C110").Value
End If
End If
If Bloc1 = "4VNC" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C110").Value
End If
End If
If Bloc1 = "4PAY" Then
If a.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D110").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C110").Value
End If
End If
 
'====================== 2e ligne ====================
If Bloc1 = "4CCS" Then
If b.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D111").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C111").Value
End If
End If
If Bloc1 = "4MOB" Then
If b.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D111").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C111").Value
End If
End If
If Bloc1 = "4VNC" Then
If b.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D111").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C111").Value
End If
End If
If Bloc1 = "4PAY" Then
If b.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D111").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C111").Value
End If
End If
'====================== 3e ligne ====================
If Bloc1 = "4CCS" Then
If c.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D112").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C112").Value
End If
End If
If Bloc1 = "4MOB" Then
If c.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D112").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C112").Value
End If
End If
If Bloc1 = "4VNC" Then
If c.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D112").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C112").Value
End If
End If
If Bloc1 = "4PAY" Then
If c.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D112").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C112").Value
End If
End If
 
'====================== 4e ligne ====================
If Bloc1 = "4CCS" Then
If d.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D113").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C113").Value
End If
End If
If Bloc1 = "4MOB" Then
If d.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D113").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C113").Value
End If
End If
If Bloc1 = "4VNC" Then
If d.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D113").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C113").Value
End If
End If
If Bloc1 = "4PAY" Then
If d.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D113").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C113").Value
End If
End If
 
'====================== 5e ligne ====================
If Bloc1 = "4CCS" Then
If e.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D114").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C114").Value
End If
End If
If Bloc1 = "4MOB" Then
If e.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D114").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C114").Value
End If
End If
If Bloc1 = "4VNC" Then
If e.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D114").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C114").Value
End If
End If
If Bloc1 = "4PAY" Then
If e.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D114").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C114").Value
End If
End If
 
'====================== 6e ligne ====================
If Bloc1 = "4CCS" Then
If f.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D115").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C115").Value
End If
End If
If Bloc1 = "4MOB" Then
If f.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D115").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C115").Value
End If
End If
If Bloc1 = "4VNC" Then
If f.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D115").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C115").Value
End If
End If
If Bloc1 = "4PAY" Then
If f.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D115").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C115").Value
End If
End If
 
'====================== 7e ligne ====================
If Bloc1 = "4CCS" Then
If g.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D116").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C116").Value
End If
End If
If Bloc1 = "4MOB" Then
If g.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D116").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C116").Value
End If
End If
If Bloc1 = "4VNC" Then
If g.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D116").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C116").Value
End If
End If
If Bloc1 = "4PAY" Then
If g.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D116").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C116").Value
End If
End If
 
'====================== 8e ligne ====================
If Bloc1 = "4CCS" Then
If h.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D117").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C117").Value
End If
End If
If Bloc1 = "4MOB" Then
If h.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D117").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C117").Value
End If
End If
If Bloc1 = "4VNC" Then
If h.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D117").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C117").Value
End If
End If
If Bloc1 = "4PAY" Then
If h.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D117").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C117").Value
End If
End If
 
'====================== 9e ligne ====================
If Bloc1 = "4CCS" Then
If i.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D118").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C118").Value
End If
End If
If Bloc1 = "4MOB" Then
If i.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D118").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C118").Value
End If
End If
If Bloc1 = "4VNC" Then
If i.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D118").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C118").Value
End If
End If
If Bloc1 = "4PAY" Then
If i.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D118").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C118").Value
End If
End If
 
'====================== 10e ligne ====================
If Bloc1 = "4CCS" Then
If j.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D119").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C119").Value
End If
End If
If Bloc1 = "4MOB" Then
If j.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D119").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C119").Value
End If
End If
If Bloc1 = "4VNC" Then
If j.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D119").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C119").Value
End If
End If
If Bloc1 = "4PAY" Then
If j.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D119").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C119").Value
End If
End If
 
'====================== 11e ligne ====================
If Bloc1 = "4CCS" Then
If k.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D120").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C120").Value
End If
End If
If Bloc1 = "4MOB" Then
If k.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D120").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C120").Value
End If
End If
If Bloc1 = "4VNC" Then
If k.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D120").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C120").Value
End If
End If
If Bloc1 = "4PAY" Then
If k.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D120").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C120").Value
End If
End If
 
'====================== 12e ligne ====================
If Bloc1 = "4CCS" Then
If l.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D121").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C121").Value
End If
End If
If Bloc1 = "4MOB" Then
If l.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D121").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C121").Value
End If
End If
If Bloc1 = "4VNC" Then
If l.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D121").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C121").Value
End If
End If
If Bloc1 = "4PAY" Then
If l.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D121").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C121").Value
End If
End If
 
'====================== 13e ligne ====================
If Bloc1 = "4CCS" Then
If m.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D122").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C122").Value
End If
End If
If Bloc1 = "4MOB" Then
If m.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D122").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C122").Value
End If
End If
If Bloc1 = "4VNC" Then
If m.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D122").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C122").Value
End If
End If
If Bloc1 = "4PAY" Then
If m.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D122").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C122").Value
End If
End If
 
'====================== 14e ligne ====================
If Bloc1 = "4CCS" Then
If n.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E9")).Value = Range("D123").Value
Sheets("Feuil1").Columns(4).Find("", Range("D9")).Value = Range("C123").Value
End If
End If
If Bloc1 = "4MOB" Then
If n.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E1")).Value = Range("D123").Value
Sheets("Feuil1").Columns(4).Find("", Range("D1")).Value = Range("C123").Value
End If
End If
If Bloc1 = "4VNC" Then
If n.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E26")).Value = Range("D123").Value
Sheets("Feuil1").Columns(4).Find("", Range("D26")).Value = Range("C123").Value
End If
End If
If Bloc1 = "4PAY" Then
If n.Value > 0 Then
Sheets("Feuil1").Columns(5).Find("", Range("E21")).Value = Range("D123").Value
Sheets("Feuil1").Columns(4).Find("", Range("D21")).Value = Range("C123").Value
End If
End If
 
End Sub

De plus après quelques essai si ca peut aider quelques personnes du forum voici le code pour mettre a jour votre tableau dynamique via un bouton ou autre commande VBA :

Code:

1
2
Set pvtTable = Worksheets("Votre Feuille").Range("Une cellule de votre tableau dynamique").pivottable
pvtTable.RefreshTable

mais je reste encore une fois sur et certain que ce code peut être simplifié.

Salut
Je ne garanti pas le code suivant, n'ayant pas excel sous la main, je l'ai tapé a la volé. je n'ai pas ton fichier non plus, donc j'ai fais ca a l'aveugle en ne tenant compte que de ton code, pas de la position des donnée sur la feuille, il sera donc peut être possible de réorganiser un peu le code.
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 'Pour la suite du code je suppose que la page active est Per1 Dim NumLigne As Long Dim TestedCell As Range 'On prend en compte une fois pour toute la valeur de Bloc1 et on détermine sur quel ligne on interviendra Select Case Bloc1 Case "4CCS" NumLigne = 9 Case "4MOB" NumLigne = 1 Case "4VNC" NumLigne = 26 Case "4PAY" NumLigne = 21 'Case "Un autre code" 'NumLigne = .. numéro de la ligne sur laquelle tu récupèreras ta valeur Case Else 'Si le code n'est pas reconnu 'mettre ici le code que tu souhaite exécuter exit sub 'par exemple End Select 'On teste les lignes une par une dans une boucle de D11 a D123 For each TestedCell in Range("D110:D123") if TestedCEll.value > 0 then 'on test si vba trouve bien une cellule qui correspond a notre recherche 'Par contre je vais pas le faire car je suis pas sur de ce que retourne Find (g pas excel la...) Sheets("Feuil1").Columns(5).Find("", cells(NumLigne,"E")).Value = TestedCEll.Value Sheets("Feuil1").Columns(4).Find("", cells(NumLigne,"D")).Value = TestedCEll.offset(0,-1).Value end if next
Il serait possible de remplacer la boucle Select Case, en renseignant chaque code et le numéro de ligne associé dans une des feuilles excel, l'avantage étant que si tu veux rajouter un code, il te suffira de le rajouter a la suite des autres dans la feuille.
Si personne ne se propose d'ici la et si tu es intéressé, je modifierais mon code Lundi ou dimanche soir.

A++
Qwaz

25/01/2010, 15h27
p0l1n

j'ai essayé ce code, et ca ne fonctionne pas.... je dois t'Avouer que je ne le comprend pas trop...
25/01/2010, 16h11
Qwazerty

Salut
Avant que je reprenne mon code.
Dis nous plutôt ce que tu souhaites faire exactement, je ne comprend pas pourquoi tu passes par un tableau croisé dynamique.
A++
Qwaz
26/01/2010, 05h24
p0l1n

mon tableur ici en fichier attaché, fait exactement ce que je veux faire.

Seule chose maintenant, c'est seulement pour simplifier le code, car ajouter un code vacance de plus à vérifier est long et pénible à coder et très long avec la technique que j'utilise.

tableur suivi

merci pour tout l'aide que vous offrez.

mais c'est tout simplement un moyen de simplifier, je ne sais comment le code.

En gros, je vérifie la 1er case du tableau dynamique quel code vacance elle contient, car il peut être différent tout dépendant comment la feuille de temps est rempli. Ensuite je prend la date et le nbr. d'heure que la personne a inscrit, et je les place dans la feuille de suivi tout dépendant quel code. Et ainsi de suite, dans mon tableau exemple je vérifie 4 case du tableau dynamique, donc il peut y avoir 4 codes vacances ou autre différents dans la feuille.

Vu qu'il n'y aura jamais plus que 4codes a suivre par feuille, c'Est pourquoi je ne ferai pas de recherche pour une 5e,6e case du tableau dynamique, mais je veux ajouter des codes vacances différents, peut-être 8 ou 9. ce qui rend la programmation pour chacune des cases tout dépendant du code et de chaque ligne très long, mais c'Est le seul moyen jai réussi a faire fonctionner comme je le voulais.

merci encore !

Salut
Voici un code un peu plus complexe, mais qui permet d'ajouter autant de code que tu souhaites.

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
Sub test()
 
'Pour la suite du code je suppose que la page active est Per1
 
Dim NumLigne As Long
Dim TestedCell As Range
 
Dim FindedCell As Range, FirstCell As String
Dim CodeCell As Range
Dim CodeVac As String, NbHeure As Double, DateExec As Date
 
 
'On boucle sur la 1er colonne contenant les codes
'La variable CodeCell va nous permetre de pointer la cellule contenant la codeVac
'Dans un 1er temps on l'initialise en lui fesant pointer la cellule d'entete du tableau en colonne B soit B109
Set CodeCell = Range("B109")
 
Do
    Set CodeCell = CodeCell.End(xlDown) 'Pointe la 1ere cellule non vide qui suit ou la derniere cellule de tableur Excel(plus de code a controler)
    'On verifie si on a un code
    If CodeCell.Value = "" Then 'On a atteind la derniere ligne du tableur excel
        'On quitte la procedure
        Exit Sub
    Else
        'On boucle alors sur la colonne des horaires effectués
        'en commencant la boucle sur la mm ligne que celle contenant la code
        'et en la terminant 13 ligne plus bas (correspondant a une periode)
        Set TestedCell = CodeCell.Offset(-1, 2) 'on se decalle egalement d'une ligne vers le haut, pour utiliser End par la suite
        Do
            'On recherche la 1er valeur non vide suivante
            Set TestedCell = TestedCell.End(xlDown)
            'On verifie que l'on est bien toujours dans la partie du tableau correspondant au Code
            If TestedCell.Row <= CodeCell.Row + 13 Then
                'On recupere le nombre d'heure est la date d'execution et le codevac
                CodeVac = CodeCell.Value
                DateExec = CDate(TestedCell.Offset(0, -1))
                NbHeure = TestedCell
 
                'On recherche dans feuil1 la 1ere ligne vide associé au codeVac
                Set FindedCell = Sheets("Feuil1").Columns("B").Find(CodeVac, LookIn:=xlValues)
                If Not FindedCell Is Nothing Then
                    FirstCell = FindedCell.Address
                    Do
                        'On regarde si la ligne contenant notre CodeVac est vierge
                        If FindedCell.Offset(0, 2) = "" Then
                            'Si oui ion l'utilise pour saisir la nouvelle entrée
                            FindedCell.Offset(0, 2) = DateExec
                            FindedCell.Offset(0, 3) = NbHeure
                            Exit Do 'on quitte cette boucle
                        End If
                        'Si la ligne n'est pas vierge on passe a la suivante
                        Set FindedCell = Sheets("Feuil1").Columns("B").FindNext(FindedCell)
                        'Si on retombe sur la 1er cellule, sur laquelle on avait commencé la boucle, alors il n'y a plus d'emplacement libre
                        If FindedCell.Address = FirstCell Then
                            MsgBox "Plus de place pour ajouter le code " & CodeVac & " du " & CStr(DateExec) & ".", vbExclamation, "Tableau plein"
                            'On passe donc au Code suivant les autres heure correspondant a ce code ne seront pas saisies
                            GoTo CodeSuivant
                        End If
                    Loop While Not FindedCell Is Nothing
                Else
                    'Ce CodeVac n'a pas d'emplacement dans la tableau de la feuil1
                    MsgBox "Le code vacance " & CodeVac & " n'existe pas dans la tableau récapitulatif.", vbExclamation, "Code Vacance introuvable"
                    Exit Do '(ou Goto CodeSuivant)
                End If
            Else
                'On est a l'exterieur de la zone du CodeVac, on quitte la boucle afin de passr au code suivant (on aurait pu utiliser Goto CodeSuivant)
                Exit Do
            End If
        Loop
    End If
 
CodeSuivant:
Loop
 
 
End Sub

J'ai mis un maximum de commentaire dans le code, si tu veux des explication en plus n'hésites pas.
A++
Qwaz