Microsoft 365 creer une feuille plage horaire à partir d'un planning

ibellot

XLDnaute Nouveau
Bonjour
voilà mon problème : je vais essayer d'etre le plus clair possible ! je réalise un planning hebdomadaire sur excel par jour pour tenir compte d'un CA et d'une productivité ( Je suis responsable d'un magasin ) je fonctionne avec des plages horaires de 8h30 à 20h 30 et par tranche de 15 mn . ce que j'aimerai c'est avoir sur une deuxieme feuille un tableau hebdo récapitulatif avec des plages horaires . je vous précise quand meme que je suis moyennement douée ... dans les formules . je joins un exemple du planning que j'ai creé ce sera plus simple . merci d'avance pour votre aide .
 

Pièces jointes

  • Projet plannigs 1.xlsx
    61.4 KB · Affichages: 40

GALOUGALOU

XLDnaute Accro
bonjour ibellot bonjour le forum
je vous propose une solution par macro
pour arriver à un résultat j'ai supprimé des cellules fusionnées dans la feuille Planning_horaire, j'ai rajouter une colonne. j'ai aussi modifier le nom de la feuille.
il vous faudra vérifiez vos formules, j'ai pu en détruire pendant la mise au point
si vous adaptez dans un autre classeur attention au respect de la mise en forme, les macros n'admettent pas l'approximation.
si un employé travaille sur une seule plage horaire, je n'ai pas réussi a positionner dans la cellule du bas pour l'après midi. une solution existe certainement. cela demande un peu de réflexion.
ci dessous le code principal.

Enrichi (BBcode):
Sub Planning_horaire()
Dim heure1 As String
Dim heure2 As String
Dim heure3 As String
Dim heure4 As String

Dim F1 As String
Dim F2 As String
F1 = Sheets("Planning").Name
F2 = Sheets("Planning_horaire").Name


For x1 = 8 To 94 'dans la feuille F1
For x2 = 4 To 24 'dans la feuille F2

  If Sheets(F1).Range("A" & x1) = Sheets(F2).Range("R1") Then
  If Sheets(F1).Range("BB" & x1) <> 0 Then

Sheets(F1).Select
Cells(x1, 2).Select
Selection.End(xlToRight).Select
    ActiveCell.Select
    y1 = ActiveCell.Column
  heure1 = Format(Cells(5, y1), "hh:mm")


          ActiveCell.Offset(0, 1).Select
    Selection.End(xlToRight).Select
    ActiveCell.Select
        y2 = ActiveCell.Column
    heure2 = Format(Cells(5, y2), "hh:mm")


     ActiveCell.Offset(0, 1).Select
    Selection.End(xlToRight).Select
    ActiveCell.Select
       y3 = ActiveCell.Column
   heure3 = Format(Cells(5, y3), "hh:mm")


    Selection.End(xlToRight).Select
       y4 = ActiveCell.Column
   heure4 = Format(Cells(5, y4), "hh:mm")


      If Sheets(F2).Range("B" & x2) = Sheets(F2).Range("R1") Then
    Sheets(F2).Select
    Sheets(F2).Cells(x2, 1).Select
ActiveSheet.Range("I" & ActiveCell.Row).End(xlToLeft).Offset(0, 1).Select
  ActiveCell = heure1 & "-" & heure2
ActiveCell = ActiveCell.Offset(1, 0).Select
ActiveCell = heure3 & "-" & heure4


    x1 = x1 + 1

End If
End If
End If
Next
Next

End Sub
cordialement
galougalou
 

Pièces jointes

  • Projet plannigs 6.xlsm
    92.8 KB · Affichages: 13
  • Projet plannings 14 .xlsm
    104.6 KB · Affichages: 9
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
313 277
Messages
2 096 766
Membres
106 746
dernier inscrit
acquabateaux