Sub Macro_Doublon()
' On met " couleur de fond ROUGE" les cellules en double du tableau
Dim NbDoublon As Integer
Dim Doublon As Boolean
Dim Fin 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("TABLEAU2")
Doublon = False
If Not (IsEmpty(cell)) Then
' on ne traite que les cellules non vides
Fin = False
For Each cell2 In .Range("TABLEAU2")
If (cell2.Value = cell.Value) And (cell.Address <> cell2.Address) And (Not Fin) Then
If (cell.Row < cell2.Row) Or ((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
Else
'les précédentes, donc le doublon a déjà été constaté et la couleur positionnée
Fin = True
End If
End If
Next
End If
Next
End With
End Sub
Sub Macro_Réinit_Doublon()
'
' On remet "sans couleur de fond" les cellules du tableau
'
With ActiveSheet
For Each cell In .Range("TABLEAU2")
With cell.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next
End With
End Sub
