Mise en forme conditionnelle.. ou formule couleur.. ou vba ..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range 'déclare la variable pl (PLage)
Dim plan As Range 'déclare la variable plan
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String ''déclare la variable pa (Première Adresse)

Set pl = Range("C4:C30") 'définit la plage pl
If Application.Intersect(Target, pl) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage pl, sort de la procédure
Set plan = Range("AF46") 'définit la variable plan (initialisation)
For Each cel In Range("D36:AE55") 'boucle sur toutes les cellules de la plage D36:AF55
    'si la couleur de la cellule est "bleu moyen" ou "rouge" ajoute la cellule à la plage plan
    If cel.Interior.ColorIndex = 37 Or cel.Interior.ColorIndex = 3 Then Set plan = Application.Union(cel, plan)
Next cel 'prochaine cellule de la boucle
plan.Interior.ColorIndex = 37 'réinitialise la couleur d'orrigine (bleu moyen)
If Target.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
Set r = plan.Find(Left(Target.Value, Len(Target.Value) - 1), , xlValues, xlWhole) 'définit la recherche r (Recherche tous les caractères sauf le dernier de la valeur de cel, dans la plage plan, valeur exacte)
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    pa = r.Address 'définit l'adresse pa de lapremière occurrence trouvée
    Do 'éxécute
        r.Interior.ColorIndex = 3 'colore la cellule de rouge
        Set r = plan.FindNext(r) 'redéfinit la recherche (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
End If 'fin de la condition
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range 'déclare la variable pl (PLage)
Dim plan As Range 'déclare la variable plan
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String ''déclare la variable pa (Première Adresse)

Set pl = Range("C4:C30") 'définit la plage pl
If Application.Intersect(Target, pl) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage pl, sort de la procédure
Cancel = True 'annule le menu contectuel lié au clic droit
Set plan = Range("AF46") 'définit la variable plan (initialisation)
For Each cel In Range("D36:AE55") 'boucle sur toutes les cellules de la plage D36:AF55
    'si la couleur de la cellule est "bleu moyen" ou "rouge" ajoute la cellule à la plage plan
    If cel.Interior.ColorIndex = 37 Or cel.Interior.ColorIndex = 3 Then Set plan = Application.Union(cel, plan)
Next cel 'prochaine cellule de la boucle
plan.Interior.ColorIndex = 37 'réinitialise la couleur d'orrigine (bleu moyen)
If Target.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
Set r = plan.Find(Left(Target.Value, Len(Target.Value) - 1), , xlValues, xlWhole) 'définit la recherche r (Recherche tous les caractères sauf le dernier de la valeur de cel, dans la plage plan, valeur exacte)
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    pa = r.Address 'définit l'adresse pa de lapremière occurrence trouvée
    Do 'éxécute
        r.Interior.ColorIndex = 3 'colore la cellule de rouge
        Set r = plan.FindNext(r) 'redéfinit la recherche (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
End If 'fin de la condition
End Sub