tableaux croisés dynamiques sur un petit emploi du temps

[Rochi]

Bonjour à tous,
je galère avec cet emploi du temps (fichier joint):
feuille 1
liste de tous les stagiaires (s1, s2, s3.....) avec leurs niveaux respectifs(aa, ba, cb, bb, etc...) et leur situation (à l'école: 1 et en stage 0)
feuille 2
l'emploi du temps des formateurs (f1, f2, f3 etc..) avec leurs interventions par niveau
feuille3
l'emploi du temps des stagiaires qui découlera forcément de la feuille 1 et 2



Si une personne veut bien se pencher sur mon problème
un grand merci🙂

 

[PMO2]

Re : tableaux croisés dynamiques sur un petit emploi du temps

Bonjour,

Une piste en VBA.

ATTENTION : je me suis entièrement référé à votre pièce jointe aussi est-il IMPERATIF de garder les structures des feuilles.

Copiez le code suivant dans un module standard (adaptez éventuellement les constantes cernées par des ###)

'### Constantes à adapter ###
Const FEUILLE_LISTE As String = "Feuil1"
Const FEUILLE_FORMS As String = "Feuil2"
'############################

Sub EmploiDuTemps()
Dim S As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim R2 As Range
Dim var1
Dim var2
Dim g&
Dim h&
Dim i&
Dim cpt&
Dim lig&
Dim A$
Dim T()
Set S = Sheets(FEUILLE_LISTE)
Set R = S.[a1].CurrentRegion
var1 = R
Set S2 = Sheets(FEUILLE_FORMS)
Set R2 = S2.[a1].CurrentRegion
var2 = R2
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Set R = S.[a1]
R2.Rows(1).Copy Destination:=R
For g& = 2 To UBound(var2, 1) Step 3
  If g& = 2 Then
    Set R = S.Range("a" & g& & "")
  Else
    Set R = S.Range("a" & S.UsedRange.Rows.Count + 2 & "")
  End If
  R2.Rows("" & g& & ":" & g& + 2 & "").Copy Destination:=R
  lig& = S.UsedRange.Rows.Count + 1
  For h& = 2 To UBound(var2, 2)
    cpt& = 0
    Erase T
    A$ = var2(g& + 2, h&)
    If A$ <> "" Then
      For i& = 2 To UBound(var1, 1)
        If var1(i&, 3) = 1 And var1(i&, 2) = A$ Then
          cpt& = cpt& + 1
          ReDim Preserve T(1 To 1, 1 To cpt&)
          T(1, cpt&) = var1(i&, 1)
        End If
      Next i&
    End If
    If cpt& > 0 Then
      Set R = S.Range(S.Cells(lig&, h&), S.Cells(lig& + cpt& - 1, h&))
      R = WorksheetFunction.Transpose(T)
    End If
  Next h&
Next g&
End Sub

Lancez la macro EmploiDuTemps et le résultat s'affichera dans une nouvelle feuille.

Cordialement.

PMO
Patrick Morange

 

[Rochi]

Re : tableaux croisés dynamiques sur un petit emploi du temps

Merci beaucoup et dire que ça fait presqu' un an que je cherche...🙂