Le processus dont vous parlez s'appelle "duplicata banding". Une paire de Scripting.Dictionary les objets devraient s'en occuper facilement.
Sub colorDuplicateColor2()
Dim d As Long, dODDs As Object, dEVNs As Object, vTMPs As Variant
Dim bOE As Boolean
Set dODDs = CreateObject("Scripting.Dictionary")
Set dEVNs = CreateObject("Scripting.Dictionary")
dODDs.CompareMode = vbTextCompare
dEVNs.CompareMode = vbTextCompare
With Worksheets("Sheet7")
If .AutoFilterMode Then .AutoFilterMode = False
With .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp))
With .Columns(1)
.Cells.Interior.Pattern = xlNone
End With
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
vTMPs = .Value2
End With
For d = LBound(vTMPs, 1) To UBound(vTMPs, 1)
'the dictionary Items have to be strings to be used as filter criteria
If Not (dODDs.exists(vTMPs(d, 1)) Or dEVNs.exists(vTMPs(d, 1))) Then
If bOE Then
dODDs.Item(vTMPs(d, 1)) = CStr(vTMPs(d, 1))
Else
dEVNs.Item(vTMPs(d, 1)) = CStr(vTMPs(d, 1))
End If
bOE = Not bOE
End If
Next d
With .Columns(1)
.AutoFilter Field:=1, Criteria1:=dODDs.Items, Operator:=xlFilterValues
.SpecialCells(xlCellTypeVisible).Interior.Color = RGB(210, 210, 210)
'use this to band the entire row
'.SpecialCells(xlCellTypeVisible).EntireRow.Interior.Color = RGB(210, 210, 210)
'use this to band the row within the UsedRange
'Intersect(.Parent.UsedRange, .SpecialCells(xlCellTypeVisible).EntireRow).Interior.Color = RGB(210, 210, 210)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=dEVNs.Items, Operator:=xlFilterValues
.SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 200, 200)
.Cells(1).EntireRow.Interior.Pattern = xlNone
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
dODDs.RemoveAll: Set dODDs = Nothing
dEVNs.RemoveAll: Set dEVNs = Nothing
Erase vTMPs
End Sub
Les données doivent être triées sur la colonne des critères en double bien sûr.
Ce processus pourrait être facilement ajusté pour une ligne complète ou une bande dans un bloc de données.