Sub Macro_Doublon()
' On met " couleur de fond ROUGE" les cellules en double du tableau
Dim NbDoublon As Integer
Dim Doublon As Boolean
Dim CouleurR As Integer
Dim CouleurV As Integer
Dim CouleurB As Integer
Dim CouleurInc As Integer
' On remet préalablement "sans couleur de fond" les cellules du tableau Macro_Réinit_Doublon
Macro_Réinit_Doublon
With ActiveSheet
NbDoublon = 0
For Each cell In .Range("TABLEAU")
Doublon = False
If Not (IsEmpty(cell)) Then
' on ne traite que les cellules non vides
For Each cell2 In .Range("TABLEAU")
If (cell2.Value = cell.Value) And (cell.Address <> cell2.Address) And _
(cell.Row <= cell2.Row) And (cell.Column <= cell2.Column) Then 'pour seulement les suivantes
' apparemment les cellules sont balayées par ligne colonne ( A2,B2 ... A3,B3 ...)
If Not Doublon Then
'Nuance de rouge pour chaque groupe de doublon
Doublon = True
CouleurInc = Application.Min(255, NbDoublon * 20)
CouleurR = 255 - CouleurInc
CouleurV = CouleurInc
CouleurB = CouleurInc
NbDoublon = NbDoublon + 1
End If
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(CouleurR, CouleurV, CouleurB)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With cell2.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(CouleurR, CouleurV, CouleurB)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End If
Next
End With
End Sub
