Microsoft 365 Coloriage de cellules par rapport à d'autres

Vincent L

XLDnaute Nouveau
Bonjour,

J'ai un tableau journalier avec des plages horaires
Chaque plage horaire doit être remplie avec une ou deux personnes
Chaque personne renseigne la plage horaire souhaité dans les colonnes B,C et D,E en face de leur nom
j'ai fait une MFC pour que quand un agent inscrit sa plage horaire, elle se remplisse en bleu
la ligne 1 est en rouge de base.
Ma question est:
Comment faire passer les cellules de la ligne 1 en vert avec ces conditions:
il doit y avoir 1 personne sur la tranche horaire 7:00 9h00, 2 personnes sur la tranche horaire 9:00 18:30 et 1 personne sur la dernière 18:30 20:00

exemple:
agent 1 rempli dans B3 7:00 et dans C3 11h00, les cellules F3 à M3 se colorent en bleu, mais je voudrait que les cellules F1 à I1 passent au vert et que temps qu'un autre agent ne c'est pas inscrit sur la plage horaire 9:00 11:00 ou plus, les cellules J1 à M1 restent au rouge

J'espere avoir été clair, merci par avance pour votre aide
 

Pièces jointes

  • test planning.xlsx
    12.9 KB · Affichages: 16
Solution
Bonjour Vincent L, Job,
Dans les heures, à force de rajouter 0.5/24 pour faire 1/2 heure il y a une petite erreur d'arrondi à la fin , en effet :
18:30 C4 moins 18:30 AC3 est égal à -2,2204E-15 et non 0, suffisant pour que l'égalité soit fausse.
J'ai donc remis les heures en "dur" en PJ.

job75

XLDnaute Barbatruc
Bonjour Vincent L, bienvenue sur XLD,

Pour un premier message, bravo ! C'est un joli problème.

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Variant, c As Range, colonne As Range, n&
Application.ScreenUpdating = False
ThisWorkbook.Names.Add "Tranche1", True 'nom défini
ThisWorkbook.Names.Add "Tranche2", True 'nom défini
ThisWorkbook.Names.Add "Tranche3", True 'nom défini
h = Application.Match("zzz", [A:A])
If Val(CStr(h)) < 3 Then Exit Sub
'---Tranche1---
For Each colonne In Range("F3:I" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 1 Then ThisWorkbook.Names.Add "Tranche1", False: Exit For
Next colonne
'---Tranche2---
For Each colonne In Range("J3:AB" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 2 Then ThisWorkbook.Names.Add "Tranche2", False: Exit For
Next colonne
'---Tranche3---
For Each colonne In Range("AC3:AF" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 1 Then ThisWorkbook.Names.Add "Tranche3", False: Exit For
Next colonne
End Sub
A+
 

Pièces jointes

  • test planning(1).xlsm
    19.5 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Vincent L, Job,
En PJ un essai par formules et MFC.
Dans chaque cellule on compte le nombre de présent avec :
VB:
=SIERREUR(SI(ET($B3<=F$2;$C3>=G$2;$B3>=0);1;0)+SI(ET($D3<=F$2;$E3>=G$2;$D3>=0);1;0);"")
et en MFC suivant les créneaux on regarde si on a 0, 1 ou 2 par rapport au nombre de salariés avec :
Code:
=NB.SI(F$3:F$100;">=1")=NB.SI($A$3:$A$100;"*")
 

Pièces jointes

  • test planning.xlsx
    14.7 KB · Affichages: 6

job75

XLDnaute Barbatruc
Re, salut sylvanu,

Avec la macro précédente la plage F1:AF1 se colore en vert si l'on efface tous les noms des agents.

Ce n'est guère gênant mais si l'on veut qu'elle se colore en rouge prenez ce fichier (2) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim h&, c As Range, colonne As Range, n&
h = Val(CStr(Application.Match("zzz", [A:A])))
Application.ScreenUpdating = False
ThisWorkbook.Names.Add "Tranche1", h > 2 'nom défini
ThisWorkbook.Names.Add "Tranche2", h > 2 'nom défini
ThisWorkbook.Names.Add "Tranche3", h > 2 'nom défini
If h <= 2 Then Exit Sub
'---Tranche1---
For Each colonne In Range("F3:I" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 1 Then ThisWorkbook.Names.Add "Tranche1", False: Exit For
Next colonne
'---Tranche2---
For Each colonne In Range("J3:AB" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 2 Then ThisWorkbook.Names.Add "Tranche2", False: Exit For
Next colonne
'---Tranche3---
For Each colonne In Range("AC3:AF" & h).Columns
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.ColorIndex <> xlNone Then n = n + 1
    Next c
    If n < 1 Then ThisWorkbook.Names.Add "Tranche3", False: Exit For
Next colonne
End Sub
A+
 

Pièces jointes

  • test planning(2).xlsm
    19.6 KB · Affichages: 6

Vincent L

XLDnaute Nouveau
Merci pour la mise à jour job75,

Par contre, quand j'ai voulu finaliser le planning et donc dupliquer le tableau, la ligne qui devait être rouge parce que personne d'inscrit, et passé au vert
J'ai beau faire et refaire la MFC, rien à faire
Quand je supprime tout le reste du planning, tout fonctionne impec sur le premier tableau "LUNDI"

Comme vous pouvez le voir dans la nouvelle pièce jointe, les besoins ne sont pas les mêmes tous les jours

  1. Pouvez vous m'aider s'il vous plaît ? 🙏🙏
  2. Je suppose que si je doit ajouter ou supprimer une hôtesse de caisse, je n'ai juste qu'à faire "insérer une ligne" ou "supprimer une ligne", j'ai bon ? :rolleyes:
Merci d'avance
 

Pièces jointes

  • planning Bâti.xlsx
    20.8 KB · Affichages: 5

job75

XLDnaute Barbatruc
La macro que j'ai donnée fonctionne pour un tableau et 3 tranches.

Pour plusieurs tableaux il vous faudra adapter la macro :

- une variable h recalculée pour chaque tableau

- des tranches adaptées à chaque tableau avec à chaque fois des noms définis différents.

C'est quand même compliqué, je vous conseille d'utiliser plutôt la solution de sylvanu.
 

Vincent L

XLDnaute Nouveau
La macro que j'ai donnée fonctionne pour un tableau et 3 tranches.

Pour plusieurs tableaux il vous faudra adapter la macro :

- une variable h recalculée pour chaque tableau

- des tranches adaptées à chaque tableau avec à chaque fois des noms définis différents.

C'est quand même compliqué, je vous conseille d'utiliser plutôt la solution de sylvanu.
Merci pour tous vos conseils

Je suis en train d'essayer avec la solution de sylvanu
 

Vincent L

XLDnaute Nouveau
Bonjour Vincent L, Job,
En PJ un essai par formules et MFC.
Dans chaque cellule on compte le nombre de présent avec :
VB:
=SIERREUR(SI(ET($B3<=F$2;$C3>=G$2;$B3>=0);1;0)+SI(ET($D3<=F$2;$E3>=G$2;$D3>=0);1;0);"")
et en MFC suivant les créneaux on regarde si on a 0, 1 ou 2 par rapport au nombre de salariés avec :
Code:
=NB.SI(F$3:F$100;">=1")=NB.SI($A$3:$A$100;"*")
Merci sylvanu,

Je teste avec votre solution, néanmoins, il y a un soucis et je ne trouve pas où

quand une hôtesse travaille jusqu'à 18:30, ça note 0 sur la dernière cellule, par contre quand une hôtesse travaille jusqu'à 19:00, la cellule notée 0 et cette fois notée 1
J'ai beau revoir la formule et je ne comprend pas d'où ça vient

Une petite idée?
Je vous mets le projet quasi terminé en pièce jointe

Encore merci d'avance @sylvanu et @job75
 

Pièces jointes

  • test planning bati.xlsx
    36.1 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Vincent L, Job,
Dans les heures, à force de rajouter 0.5/24 pour faire 1/2 heure il y a une petite erreur d'arrondi à la fin , en effet :
18:30 C4 moins 18:30 AC3 est égal à -2,2204E-15 et non 0, suffisant pour que l'égalité soit fausse.
J'ai donc remis les heures en "dur" en PJ.
 

Pièces jointes

  • test planning bati V2.xlsx
    34.9 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Vincent L, sylvanu,

En fait mes macros précédentes n'étaient pas fameuses.

Celle-ci va bien dans le fichier joint :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim jour, deb As Range, fin As Range, h&, c As Range, i As Variant, j As Variant, Nhotesse&, cc As Range
Application.ScreenUpdating = False
For Each jour In Array("LUNDI", "MARDI", "MERCREDI", "JEUDI", "VENDREDI", "SAMEDI", "DIMANCHE")
    Set deb = [A:A].Find(jour, , xlValues, xlPart)
    Set fin = [A:E].Find("Besoin", deb)
    h = fin.Row - deb.Row - 1
    Range(deb(0, 6), Cells(fin.Row - 1, Columns.Count)).Interior.ColorIndex = xlNone 'RAZ
    Range(deb(0, 6), deb(1, Columns.Count).End(xlToLeft)(0)).Interior.Color = vbRed 'RAZ en rouge
    If h > 0 Then
        '---couleur bleue---
        For Each c In Union(deb(1, 2).Resize(h), deb(1, 4).Resize(h))
            If IsNumeric(CStr(c)) And IsNumeric(c(1, 2)) And c(1, 2) > c Then
                i = Application.Match(c + 1 / 10000, deb.EntireRow)
                j = Application.Match(c(1, 2) - 1 / 10000, deb.EntireRow)
                If IsNumeric(i) And IsNumeric(j) Then Range(Cells(c.Row, i), Cells(c.Row, j)).Interior.Color = RGB(0, 176, 240)
            End If
        Next c
        '---couleur verte---
        For Each c In Range(deb(0, 6), deb(1, Columns.Count).End(xlToLeft)(0))
            Nhotesse = Int(Val(Cells(fin.Row, c.Column).MergeArea(1))) 'on se sert des cellules fusionnées...
            If Nhotesse > 0 Then
                i = 0
                For Each cc In c(3).Resize(h)
                    If cc.Interior.Color = RGB(0, 176, 240) Then i = i + 1
                    If i = Nhotesse Then c.Interior.Color = vbGreen: Exit For
                Next cc
            End If
        Next c
    End If
Next jour
End Sub
Il n'y a plus aucune MFC dans la feuille.

A+
 

Pièces jointes

  • test planning bati(1).xlsm
    38.2 KB · Affichages: 8
Dernière édition:

Vincent L

XLDnaute Nouveau
@sylvanu et @job75 tout d’abord, un ÉNORME merci à vous deux

Pour en avoir parlé avec ma femme, puisque c'est elle et ses collègues qui vont l'utiliser

Elle préfère que le nombre d'hôtesse inscrite apparaisse dans la ligne rouge puis verte, du coup, c'est la version de @sylvanu qui l'a remporté, mais je garde bien précieusement votre version @job75

Du coup, un nouveau problème vient se greffer

J'ai peur qu'une des filles viennent remplir directement le tableau et du coup effacer la formule dans la cellule.

Voici ma question:

Est-il possible de protéger en écriture de la cellule F2 à AF84 tout en laissant la possibilité de rajouter et/ou supprimer des lignes ?

Je vous mets en pièce jointe le planning renseigné en test

Merci d'avance
 

Pièces jointes

  • test planning bati V2.xlsx
    38 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
Comme je suppose que c'est votre femme qui rajoutera des lignes, le mieux est de protéger la feuille, vous serez tranquille.
Vous déprotégez les plage horaires et vous mettez un mot de passe. Dans ce cas seules les plages horaires seront accessibles.
Voir exemple en PJ. Mot de passe : vincent
 

Pièces jointes

  • test planning bati V3.xlsx
    37.2 KB · Affichages: 4
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 732
Messages
2 081 997
Membres
101 861
dernier inscrit
Jerem28630