Discussion :

[madron]

Gestion des services-1.xls
Je joints mon tableau, l'onglet explicit décrit ce que je veux obtenir et ce que j'ai fait.
Pour faire court, 3 onglets.
1) PERSONNELS:
chaque personnel est suivit par numéro ID
On y trouve les informations nécessaires au suivis de ceux ci.
2) SAISIE_INDISPO:
j'ai fait comme un formulaire de saisie: sélection de l'ID, date de début, date de fin de période, calcul de jours indisponible, motif indisponibilité, INDIC est une case contenant un code couleur à copier sur l'onglet CALENDAR aux dates correspondantes pour le personnel correspondant.
En fond jaune, j'ai des formules me permettant d'identifier la colonne (le personnel) , la première ligne et la dernière ligne de l'indisponibilité saisie (dates), et enregistré.
3)CALENDAR :
1ère ligne: les ID de mes personnels (classés par ordre chronologique)
1ère colonne: dates, du 01/09/2013 au 31/08/2016.
Les cases doivent contenir les indisponibilités saisies dans l'onglet précédent ainsi que les services (astreintes et permanences diverses)- celles-ci seront saisies manuellement par un opérateur suivant un code couleur pré définit (une lettre/une couleur/un fond=un code service). Par exemple, une permanence sera identifiée par un "1" blanc sur fond vert. Alors qu'une indisponibilité d'ordre personnelle sera identifiée par un "X" rouge sur fond gris.

Mon problème est de mettre en place une macro qui incrémente les cases de mon calendrier des indisponibilités saisies.
Help me please!

Merci d'avance.
Un autodidacte en panique devant VBA...

[Daniel.C]

Bonjour,

Poste ton classeur. Si tu l'as déjà fait, peut-être qu'un modérateur l'a ôté (tu n'es pas censé mettre une pièce jointe avec ton premier message).

[madron]

Merci pour la remarque.
Effectivement il n'a pas été joint.
C'est fait.

Respectueusement.

[mercatog]

Pour copier l'ensemble des lignes vers leur destination

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
Sub Traitement()
Dim N As Long, i As Long
Dim D As Long, F As Long
Dim C As Integer
 
Application.ScreenUpdating = False
With Worksheets("SAISIE_INDISPO")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    If N > 4 Then
        For i = 5 To N
            C = .Cells(i, 10)                    'Colonne
            D = .Cells(i, 11)                    'Ligne Début
            F = .Cells(i, 12)                    'Ligne Fin
            .Cells(i, 8).Copy Worksheets("CALENDAR").Cells(D, C).Resize(F - D + 1)
        Next i
    End If
End With
End Sub

[madron]

😂 j'étais entrain d'en pleurer....
Merci ça fonctionne. Je vais essayer de comprendre comment maintenant... Après viendra le temps de faire les comptes... Mais je posterais à nouveau si je trouve pas.

Merci beaucoup !

Respectueusement, maître.

[Daniel.C]

Essaie cette macro. Pour être complet, il faudrait effacer la feuille avant exécution au cas où tu aurais fait des modifs.

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
Sub test()
    Dim C As Range, Plage As Range, Ligne As Long, Dat As Date
    With Sheets("SAISIE_INDISPO")
        Set Plage = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("CALENDAR")
        For Each C In Plage
'            If C.Row = 7 Then Stop
            Ligne = Application.Match(C.Offset(, 3) * 1, .Columns(1), 0) - 1
            Dat = C.Offset(, 3)
            Do While Dat <= C.Offset(, 4)
                C.Offset(, 7).Copy .Range("A1").Offset(Ligne, C.Value)
                Ligne = Ligne + 1
                Dat = Dat + 1
            Loop
        Next C
    End With
End Sub

PS. Tâche d'effacer ton classeur initial pour effacer les noms.

[madron]

Pour copier l'ensemble des lignes vers leur destination

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
Sub Traitement()
Dim N As Long, i As Long
Dim D As Long, F As Long
Dim C As Integer
 
Application.ScreenUpdating = False
With Worksheets("SAISIE_INDISPO")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    If N > 4 Then
        For i = 5 To N
            C = .Cells(i, 10)                    'Colonne
            D = .Cells(i, 11)                    'Ligne Début
            F = .Cells(i, 12)                    'Ligne Fin
            .Cells(i, 8).Copy Worksheets("CALENDAR").Cells(D, C).Resize(F - D + 1)
        Next i
    End If
End With
End Sub

Problème: une mise en forme conditionnelle est en place sur la feuille CALENDAR. Après intégration des indisponibilités saisies, celles-ci modifies le champ d'application de la mise en forme conditionnelle, ce qui fait qu'en cas de modification ou annulation, ce qui arrive souvent, la mise en forme ne s'applique plus aux cellules modifiées par l'intégration des indisponibilités. Une solution ?
Je pensais à ne plus copier que la valeur de la case INDIC, sans sa mise en forme, pour ne plus modifier les conditionnelles de CALENDAR, mais est-ce possible ?

Cordialement

[madron]

Essaie cette macro. Pour être complet, il faudrait effacer la feuille avant exécution au cas où tu aurais fait des modifs.

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
Sub test()
    Dim C As Range, Plage As Range, Ligne As Long, Dat As Date
    With Sheets("SAISIE_INDISPO")
        Set Plage = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("CALENDAR")
        For Each C In Plage
'            If C.Row = 7 Then Stop
            Ligne = Application.Match(C.Offset(, 3) * 1, .Columns(1), 0) - 1
            Dat = C.Offset(, 3)
            Do While Dat <= C.Offset(, 4)
                C.Offset(, 7).Copy .Range("A1").Offset(Ligne, C.Value)
                Ligne = Ligne + 1
                Dat = Dat + 1
            Loop
        Next C
    End With
End Sub

PS. Tâche d'effacer ton classeur initial pour effacer les noms.

J'essaie dès ce soir.

Par contre mon onglet CALENDAR ne doit pas être effacé. En effet, dans un soucis d'équité il me faut un historique des services montés par les personnels. Certains ne se montent qu'une à deux fois par ans. Pour ne pas mettre deux fois sur 3 ans le même personnel alors qu'ils sont 30 à pouvoir le monter... Vous comprenez ?
J'ai essayé de faire le CALENDAR de façon à pouvoir l'étendre rapidement pour augmenter l'historique (après 2016 par exemple)
Jusque là, les services montés sont conservés en archive papier par tableau mensuel... Je compte simplifier les recherches et les comptes de service fait, par chaque personnel en mesurant son taux de participation...

Je sais pas si je m'exprime assez clairement pour transmettre ma façon de voir de la finalité à atteindre.

Cordialement

[Daniel.C]

Celle-ci est plus rapide que ma précédente :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub test2()
    Dim C As Range, Plage As Range, Ligne As Long, Dat As Date
    With Sheets("SAISIE_INDISPO")
        Set Plage = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("CALENDAR")
        For Each C In Plage
            Ligne = Application.Match(C.Offset(, 3) * 1, .Columns(1), 0) - 1
            C.Offset(, 7).Copy .Range("A1").Offset(Ligne, C.Value).Resize(C.Offset(, 4) - C.Offset(, 3) + 1)
        Next C
    End With
End Sub

Par contre, est-ce que tu pourrais montrer ce que tu veux :

* Il faut pouvoir avoir un visuel mensuel de la disponibilité des personnels. (mise en forme automatique?)

[mercatog]

Je pensais à ne plus copier que la valeur de la case INDIC, sans sa mise en forme, pour ne plus modifier les conditionnelles de CALENDAR, mais est-ce possible ?

Remplace la ligne 14 par celle ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("CALENDAR").Cells(D, C).Resize(F - D + 1).Value = .Cells(i, 8).Value

[madron]

Remplace la ligne 14 par celle ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("CALENDAR").Cells(D, C).Resize(F - D + 1).Value = .Cells(i, 8).Value

Ça, c'est fait et ça fonctionne bien. Merci !

Je prépare un topo sur une deuxième version du fichier pour répondre à M. Daniel C.

Merci pour votre indulgence.

[Daniel.C]

Je prépare un topo sur une deuxième version du fichier pour répondre à M. Daniel C.

Pas de "Monsieur" entre nous ! d'abord, aujourd'hui, j'ai décidé d'être une dame... Sérieusement, pas la peine de faire une deuxième mouture puisque la version de mercatog te convient.

ah, pardon, oui, il y a le prénom dans le profil...