Sub Supprimer_lignes_doublons()
Dim rc&, a$(), i&, mat, s, u%, j&, t$, k%
With Feuil1.[C4:L7] 'CodeName de la feuille et plage à adapter
rc = .Rows.Count
ReDim a(1 To rc, 1 To 2) 'tableau à 2 dimensions, base 1
'---mémorisation pour accélérer---
For i = 1 To rc
mat = Application.Transpose(Application.Transpose(.Rows(i)))
a(i, 1) = " " & Trim(Join(mat)) & " "
a(i, 2) = "0"
Next
'---comparaison---
For i = rc To 1 Step -1
s = Split(a(i, 1))
u = UBound(s) - 1
For j = 1 To rc
If j <> i And a(j, 2) = "0" Then
t = a(j, 1)
For k = 1 To u
If Not t Like "* " & s(k) & " *" Then GoTo 1
Next
a(i, 2) = "#N/A" 'repère
Exit For
End If
1 Next
Next
'---suppression---
Application.ScreenUpdating = False
.Columns(1).Insert xlToRight 'colonne auxiliaire
.Columns(0) = Application.Index(a, , 2)
.EntireRow.Sort .Columns(0), xlAscending, Header:=xlNo 'tri
On Error Resume Next 's'il n'y a pas de #N/A
.Columns(0).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
.Columns(0).Delete xlToLeft
End With
End Sub