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]

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

Vous ne savez pas qu'avec VBA on peut tout faire ? C'est très facile, voyez ce fichier (2) :

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
Application.EnableEvents = False 'désactive les évènements
On Error GoTo 1 'sécurité
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
    With Range(deb(0, 6), deb(1, Columns.Count).End(xlToLeft)(0))
        .Interior.Color = vbRed 'RAZ en rouge
        .ClearContents 'RAZ des valeurs
        .Cells(2, 2).Resize(, .Columns.Count - 1) = "=RC[-1]+1/48" 'sécurité, reconstitue les formules des heures
    End With
    If h > 0 Then
        '---couleur bleue---
        For Each c In Union(deb(2, 2).Resize(h), deb(2, 4).Resize(h))
            i = Application.Match(c + "1E-9", deb.EntireRow)
            j = Application.Match(c(1, 2) + "1E-9", deb.EntireRow)
            If IsNumeric(i) And IsNumeric(j) Then If j > i Then _
                Cells(c.Row, i).Resize(, j - i).Interior.Color = RGB(0, 176, 240)
        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.ColorIndex <> xlNone Then i = i + 1
                    If i >= Nhotesse Then c.Interior.Color = vbGreen
                Next cc
                If i Then c = i 'FACULTATIF, inscrit le nombre dans la cellule
            End If
        Next c
    End If
Next jour
1 Application.EnableEvents = True 'réactive les évènements
If Err Then MsgBox "Vous savez sûrement ce qui ne va pas !", 48, "Erreur"
End Sub

J'en ai profité pour rendre impossible la modification des formules des heures

Edit : ajouté une validation des données pour les heures en colonnes B à E.

Bonne nuit.