comparer des lignes à bases des critères

Sub Supprimer_lignes_doublons()
Dim rc&, a$(), i&, mat, s, u%, j&, t$, k%, sup As Range
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)) & " "
  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) = "" Then
        t = a(j, 1)
        For k = 1 To u
          If Not t Like "* " & s(k) & " *" Then GoTo 1
        Next
        Set sup = Union(.Rows(i), IIf(sup Is Nothing, .Rows(i), sup))
        a(i, 2) = 1 'repère
        Exit For
      End If
1   Next
  Next
  '---suppression---
  If Not sup Is Nothing Then sup.EntireRow.Delete
End With
End Sub

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

Sub Supprimer_lignes_doublons()
Dim rc&, a$(), i&, mat, s, 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)) & " "
  Next
  '---comparaison---
  For i = rc To 1 Step -1
    a(i, 2) = "#N/A"
    s = Split(a(i, 1))
    For j = 1 To UBound(s) - 1
      t = " " & s(j) & " "
      For k = 1 To rc
        If k <> i And Len(a(k, 2)) < 2 Then _
          If InStr(a(k, 1), t) Then GoTo 1
      Next
      a(i, 2) = "0"
      Exit For
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

With Feuil1.[A1:K27] 'CodeName de la feuille et plage à adapter