recpt individuel à partir d'un planning

[patrick7676]

bonjour a tous
un petit problème pour tous ceux qui ne sont pas partis à la neige

sur le premier tableau vous avez en fonction du jour et de la matière enseignée ( histoire , géographie , maths etc ....) le positionnement des élèves .

Je souhaiterais à partir d'une fiche retrouvé le jour concerné ( je pense à des listes en cascades ) en triant les mois .
De ce jour concerné je veux retrouvé les élèves dans les différentes matières .

ci joint un fichier

je vous souhaite un bon appétit
merci

 

[patrick7676]

Re : recpt individuel à partir d'un planning

pas un bout de piste pour m'aider

merci

 

[patrick7676]

Re : recpt individuel à partir d'un planning

une petite aide pour m'aider à résoudre ce problème
trop de monde pour regarder sans me donner un bout de reponse

 

[patrick7676]

Re : recpt individuel à partir d'un planning

une aide sVP avec des formules
merci

 

[mapomme]

Re : recpt individuel à partir d'un planning

Bonsoir patrick7676,

Minute papillon! Nous ne sommes que de modestes bénévoles qui avons aussi (et surtout) une vie ailleurs que sur XLD. Ainsi nous répondons suivant nos disponibilités, notre humeur, notre envie de répondre à la question et selon l'air du temps.

J'avais commencé à répondre à votre question mais en VBA. Le résultat est dans le fichier joint. Maintenant vous précisez 'par formule' (ce n'était pas mentionné dans le premier post). Personnellement je m'arrête à cette version, sauf le cas échéant, à apporter quelque correction. A moins que mon humeur... Mais non !

 

[patrick7676]

Re : recpt individuel à partir d'un planning

excuse moi si je t'ai froissé . je sais que tout le monde ici est bénévole .
Cependant vu le nombre de personnes qui regardait le document , je pensais que quelqu'un pouvait me donner une piste de travail . Je viens de regarder ton travail , il est excellent .
cependant je vais avoir du mal à le retranscrire dans mon application , c'est pour cela qu'une piste avec formule me parraissait plus facile à maitriser

 

[mapomme]

Re : recpt individuel à partir d'un planning

Bonjour patrick7676 ,

excuse moi si je t'ai froissé . je sais que tout le monde ici est bénévole .
Cependant vu le nombre de personnes qui regardait le document , je pensais que quelqu'un pouvait me donner une piste de travail . Je viens de regarder ton travail , il est excellent .
cependant je vais avoir du mal à le retranscrire dans mon application , c'est pour cela qu'une piste avec formule me parraissait plus facile à maitriser

Rassure toi, je n'étais pas froissé, même pas chiffonné . Et pour preuve, voici une version sans code VBA, avec uniquement des formules. Le principe est de ventiler le planning sur une feuille masquée. Ensuite, à partir de ces données réorganisées, on construit les TCD que l'on souhaite. Il y a sans doute mieux! La feuille masquée s'appelle 'Ventil'.

Quand on rajoute (surtout) ou retire (dans une moindre mesure pour la performance) des colonnes ou des lignes au planning, il faut vérifier que les formules de la feuille 'Ventil' soient tirées/copiées suffisamment bas. Ensuite il faut, le cas échéant, changer la source des données.

Ne pas oublier de réactualiser le TCD quand on change des valeurs dans la planning.

 

[patrick7676]

Re : recpt individuel à partir d'un planning

merci pour le travail , peut on faire une liste déroulante à partir des mois pour éviter tous les jours affichés en même temps .De ce fait si je sélectionne le mois de juin , je n'aurais que les jours de juin

merci

 

[mapomme]

Re : recpt individuel à partir d'un planning

Bonsoir patrick7676,

Désolé, je ne sais pas répondre à ta demande car pas assez calé en TCD

 

[klin89]

Bonsoir le forum,

De retour sur ce fil, histoire de ne pas perdre la main avec les dictionnaires

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, e, s
Dim dico As Object
    a = Sheets("planning").Range("b4").CurrentRegion.Value
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    For i = 2 To UBound(a, 2)
        If IsEmpty(a(1, i)) Then a(1, i) = a(1, i - 1)
        If Not dico.exists(a(1, i)) Then
            Set dico(a(1, i)) = _
            CreateObject("Scripting.Dictionary")
            dico(a(1, i)).CompareMode = 1
        End If
        dico(a(1, i))(a(2, i)) = Empty
        For j = 3 To UBound(a, 1)
            If a(j, i) <> "" Then
                If IsEmpty(dico(a(1, i))(a(2, i))) Then
                    ReDim w(1 To 1)
                Else
                    w = dico(a(1, i))(a(2, i))
                    ReDim Preserve w(1 To UBound(w) + 1)
                End If
                w(UBound(w)) = a(j, 1)
                dico(a(1, i))(a(2, i)) = w
            End If
        Next
    Next
    'restitution et mise en forme
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1)
        .Parent.Cells.Clear
        For Each e In dico.keys
            With .Offset(n)
                .FormulaLocal = e
                .NumberFormat = "dddd dd mmmm yyyy"
                With .Resize(, 6)
                    .HorizontalAlignment = xlCenterAcrossSelection
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 36
                End With
            End With
            For Each s In dico(e).keys
                n = n + 1
                With .Offset(n, 2)
                    .Value = s
                    With .Resize(, 2)
                        .HorizontalAlignment = xlCenterAcrossSelection
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = 44
                    End With
                End With
                n = n + 1
                If Not IsEmpty(dico(e)(s)) Then
                    w = dico(e)(s)
                    With .Offset(n, 2).Resize(UBound(w))
                        .Value = Application.Transpose(dico(e)(s))
                        With .Resize(, 2)
                            .BorderAround Weight:=xlThin
                            .Borders(xlInsideVertical).Weight = xlThin
                        End With
                        n = n + UBound(w)
                    End With
                End If
            Next
            n = n + 1
        Next
        With .Parent.UsedRange
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .Columns.ColumnWidth = 11
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89