Résumé de planning (date et poste par agent)

[Docdav]

Bonjour à tous, sur ce forum où je découvre des as de l'excel...j'en apprends tous les jours, et ceux qui me trouvent un crack ne savent pas que je suis en fait tout en bas de l'échelle....

Je cherche à extraire d'un planning la liste des dates pour chaque agent (pour leur donner leur jours de travail).
J'ai 9 colonnes, la 1ère les dates, puis Jour/Nuit x4

Je cherche à avoir, à côté ou sur une autre feuille, toutes les dates (en vertical si possible, mais sinon tant pis) pour un agent, avec si possible la mention de la colonne conservée.

Je mets un fichier exemple.
(c) CJoint.com, 2012

Je suis avec excel 2011 sur Mac Os, pas de limitation VBA ou autre.

Un grand merci d'avance...
David.

 

[CISCO]

Re : Résumé de planning (date et poste par agent)

Bonjour

Une possibilité en pièce jointe, avec deux formules matricielles à valider avec Ctrl+maj tempo+entrer.

@ plus

 

[PMO2]

Re : Résumé de planning (date et poste par agent)

Bonjour,

Une piste en VBA avec le code suivant à copier dans un module Standard

Sub ResumePlanning()
Dim Coll As New Collection
Dim var
Dim i&
Dim j&
Dim k&
Dim cpt&    'compteur
Dim cpt2&   'compteur
Dim bool As Boolean
Dim A$
Dim T()
'---
var = ActiveSheet.[c1].CurrentRegion.Value
On Error Resume Next
For i& = 2 To UBound(var, 1)
  For j& = 5 To UBound(var, 2)
    A$ = var(i&, j&)
    If A$ <> "" And A$ <> "-" Then
      
      Coll.Add A$, A$
    End If
  Next j&
Next i&
Err.Clear
On Error GoTo 0
'---
For k& = 1 To Coll.Count
  A$ = Coll(k&)
  For i& = 2 To UBound(var, 1)
    cpt2& = 3
    bool = False
    For j& = 5 To UBound(var, 2)
      If var(i&, j&) = A$ Then
        If Not bool Then
          cpt& = cpt& + 1
          ReDim Preserve T(1 To 11, 1 To cpt&)
          T(1, cpt&) = A$
          T(2, cpt&) = var(i&, 3) & " " & var(i&, 4)
          bool = True
        End If
        T(cpt2&, cpt&) = var(1, j&)
        cpt2& = cpt2& + 1
      End If
    Next j&
  Next i&
Next k&
'---
If Coll.Count > 0 Then
  Sheets.Add
  ActiveSheet.Range(Cells(1, 1), Cells(UBound(T, 2), UBound(T, 1))) = Application.WorksheetFunction.Transpose(T)
Else
  MsgBox "Avez-vous sélectionné une feuille ''Planning'' valide ?"
End If
End Sub

Sélectionnez la feuille "Planning" et lancez la macro "ResumePlanning".
Le résultat s'affiche dans une nouvelle feuille.

 

[Docdav]

Re : Résumé de planning (date et poste par agent)

Super génial !!!!
Je vais devoir prendre une aspirine pour comprendre la formule, ça va me faire progresser...
Je voudrais qu'il mette sur la même ligne Jour et Nuit de la même date, il faut rajouter un test supplémentaire ?

 

[Docdav]

Re : Résumé de planning (date et poste par agent)

Ouch ! rapide et super efficace, je n'ai plus qu'àa coller ça dans une feuille planning avec mfc du nom par agent et zou !
Es-il possible de faire chaque agent sur une feuille séparée lors de la macro (j'ai arrêté le basic après mon amstrad en 89...)

Vous êtes des bêtes !!!

 

[PMO2]

Re : Résumé de planning (date et poste par agent)

Bonjour,

Es-il possible de faire chaque agent sur une feuille séparée lors de la macro

Le code suivant crée une feuille par agent dans un nouveau classeur

Sub ResumePlanningNewClasseur()
Dim WB As Workbook
Dim S As Worksheet
Dim Coll As New Collection
Dim var
Dim i&
Dim j&
Dim k&
Dim cpt&    'compteur
Dim cpt2&   'compteur
Dim bool As Boolean
Dim A$
Dim T()
Dim T2()
'---
var = ActiveSheet.[c1].CurrentRegion.Value
On Error Resume Next
For i& = 2 To UBound(var, 1)
  For j& = 5 To UBound(var, 2)
    A$ = var(i&, j&)
    If A$ <> "" And A$ <> "-" Then
      Coll.Add A$, A$
    End If
  Next j&
Next i&
Err.Clear
On Error GoTo 0
'---
For k& = 1 To Coll.Count
  A$ = Coll(k&)
  For i& = 2 To UBound(var, 1)
    cpt2& = 3
    bool = False
    For j& = 5 To UBound(var, 2)
      If var(i&, j&) = A$ Then
        If Not bool Then
          cpt& = cpt& + 1
          ReDim Preserve T(1 To 11, 1 To cpt&)
          T(1, cpt&) = A$
          T(2, cpt&) = var(i&, 3) & " " & var(i&, 4)
          bool = True
        End If
        T(cpt2&, cpt&) = var(1, j&)
        cpt2& = cpt2& + 1
      End If
    Next j&
  Next i&
Next k&
'---
If Coll.Count = 0 Then
  MsgBox "Avez-vous sélectionné une feuille ''Planning'' valide ?"
  Exit Sub
End If
'---
ReDim Preserve T(1 To UBound(T, 1), 1 To UBound(T, 2) + 1)
T = Application.WorksheetFunction.Transpose(T)
'---
Set WB = Workbooks.Add(xlWBATWorksheet)
'---
cpt& = 1
For i& = 1 To UBound(T, 1)
  ReDim Preserve T2(1 To UBound(T, 2), 1 To cpt&)
  If cpt& = 1 Then
    For j& = 1 To UBound(T, 2)
      T2(j&, cpt&) = T(i&, j&)
    Next j&
  Else
    If T(i&, 1) = T(i& - 1, 1) Then
      For j& = 1 To UBound(T, 2)
        T2(j&, cpt&) = T(i&, j&)
      Next j&
    Else
      Set S = WB.Sheets.Add(after:=WB.Sheets(WB.Sheets.Count))
      S.Name = T(i& - 1, 1)
      S.Range(S.Cells(1, 1), S.Cells(UBound(T2, 2), UBound(T2, 1))) = Application.WorksheetFunction.Transpose(T2)
      cpt& = 0
      Erase T2
      i& = i& - 1
    End If
  End If
  cpt& = cpt& + 1
Next i&
Application.DisplayAlerts = False
WB.Sheets(1).Delete
Application.DisplayAlerts = True
End Sub

 

[Docdav]

Re : Résumé de planning (date et poste par agent)

Vous êtes tout simplement génial !!! Vous êtes des fous furieux d'excel !!!
Un grand merci...

Je vais essayer de digérer ça, mais il n'y en a pas la moitié que je comprends, je vais déjà commencer par comprendre la logique du code.