Microsoft 365 Coloriage de cellules par rapport à d'autres

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

=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);"")

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

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

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