Microsoft 365 Coloriage de cellules par rapport à d'autres

[Vincent L]

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

 

[job75]

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 :

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+

 

[sylvanu]

Bonjour Vincent L, Job,
En PJ un essai par formules et MFC.
Dans chaque cellule on compte le nombre de présent avec :

=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 :

=NB.SI(F$3:F$100;">=1")=NB.SI($A$3:$A$100;"*")

 

[Vincent L]

Bonjour job75 et sylvanu,

Un grand merci, c'est ce que je recherchais

Je vais essayer de continuer avec vos conseils, mais je vais surement revenir vers vous

Encore merci

 

[job75]

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) :

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+

 

[Vincent L]

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 ?

Merci d'avance

 

[job75]

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.

 

[job75]

Cela dit si vous mettez chaque tableau à droite du précédent l'adaptation sera très facile.

Il y aura une seule colonne pour les noms et un seul calcul de la variable h.

Bonne nuit.

 

[Vincent L]

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]

Bonjour Vincent L, Job,
En PJ un essai par formules et MFC.
Dans chaque cellule on compte le nombre de présent avec :

=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 :

=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

 

[sylvanu]

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]

Bonjour Vincent L, sylvanu,

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

Celle-ci va bien dans le fichier joint :

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+

 

[Vincent L]

@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

 

[sylvanu]

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

 

[Vincent L]

Encore Merci à vous deux, @sylvanu et @job75 vous m'avez été d'une aide précieuse.

Je garde tous vos conseils bien précieusement, ils me seront certainement très utiles