Sub Test2()
Application.ScreenUpdating = False
Dim Dico As Object
Set plage = ActiveSheet.Range("A1").CurrentRegion 'on détecte la plage à colorer
plage.Interior.Color = xlNone 'on enlève la coloration en cours
For i = 2 To plage.Rows.Count 'pour chaque ligne de la plage (hors ligne d'entete)
Set Dico = CreateObject("Scripting.dictionary") 'on déclare le dico
For j = 1 To plage.Columns.Count 'pour chaque colonne de la ligne
Val0 = plage.Cells(i, j) 'on récupère la valeur
If Val0 <> "" Then 'si il y a une valeur
If Not Dico.exists(Val0) Then 'si elle n'est pas dans le dico
Dico.Add Val0, Val0 'on l'ajoute au dico
End If
End If
Next j
a = Dico.keys 'on transvase les clés du dico dans un tablo
Select Case Dico.Count 'selon le nombre de valeurs différentes detectées
Case 1
Val1 = a(0)
Case 2
Val1 = WorksheetFunction.Min(a(0), a(1))
Val2 = WorksheetFunction.Max(a(0), a(1))
Case 3
Val1 = WorksheetFunction.Min(a(0), a(1), a(2))
Val3 = WorksheetFunction.Max(a(0), a(1), a(2))
For k = 0 To 2
If a(k) <> Val1 And a(k) <> Val3 Then Val2 = a(k)
Next k
End Select
'on passe à la coloration
For j = 1 To plage.Columns.Count
Select Case plage.Cells(i, j)
Case ""
plage.Cells(i, j).Interior.Color = xlNone
Case Val1
plage.Cells(i, j).Interior.Color = vbGreen
Case Val2
plage.Cells(i, j).Interior.Color = vbYellow
Case Val3
plage.Cells(i, j).Interior.Color = vbRed
End Select
Next j
Set Dico = Nothing 'on supprime le dico pour la ligne suivante
Next i
Set Dico = Nothing
Application.ScreenUpdating = True
End Sub