IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA - valeur d'intersection


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut 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 !
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour,
    ci-joint un petit fichier exemple (j'ai scindé en 2feuilles)
    et le code correspondant
    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
    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

  3. #3
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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 !

  4. #4
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut 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 : 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
    '======================== 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 !

  5. #5
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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

  6. #6
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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 !

  7. #7
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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

  8. #8
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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é !

  9. #9
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  10. #10
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Call Bloc_1
    Call Bloc_2
    Call Bloc_3
    et un module par bloc du tableau dynamique :

    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
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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é.

  11. #11
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    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 : 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
    '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

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  12. #12
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    j'ai essayé ce code, et ca ne fonctionne pas.... je dois t'Avouer que je ne le comprend pas trop...

  13. #13
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    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

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  14. #14
    Membre averti
    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    26
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Janvier 2010
    Messages : 26
    Par défaut
    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 !

  15. #15
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Voici un code un peu plus complexe, mais qui permet d'ajouter autant de code que tu souhaites.
    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
    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

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

Discussions similaires

  1. Access/vba "Valeur incorrecte pour ce champ"
    Par vto59 dans le forum IHM
    Réponses: 4
    Dernier message: 16/06/2009, 16h26
  2. [word vba] valeur d'un champ pour un caption
    Par greg778 dans le forum VBA Word
    Réponses: 2
    Dernier message: 16/06/2008, 09h25
  3. [E-VBA] Valeur actualisée nette
    Par yop66 dans le forum Macros et VBA Excel
    Réponses: 24
    Dernier message: 14/05/2008, 19h08
  4. [VBA]Valeur suivante dans Liste déroulante
    Par Simon2 dans le forum VBA Access
    Réponses: 8
    Dernier message: 17/04/2007, 03h18
  5. [VBA]valeur par défaut, champ
    Par docky dans le forum VBA Access
    Réponses: 11
    Dernier message: 16/04/2007, 23h22

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo