Supprimer Doublons sous conditions VBA

Sub GarderMax()
Dim nlig&, xrg As Range

  Application.ScreenUpdating = False
  nlig = Range("a" & Rows.Count).End(xlUp).Row
  Range("g:h").Insert Shift:=xlToRight
  Range("g2").FormulaR1C1 = "=N(RC[-5])"
  Range("g2:g" & nlig).FillDown
  Range("g2:g" & nlig).Value = Range("g2:g" & nlig).Value
  Range("a1:g" & nlig).Sort key1:=Range("a1"), order1:=xlAscending, _
        key2:=Range("g1"), order2:=xlAscending, Header:=xlYes
  Range("h2").FormulaR1C1 = "=1/(RC[-7]<>R[1]C[-7])"
  Range("h2:h" & nlig).FillDown
  Range("h2:h" & nlig).Value = Range("h2:h" & nlig).Value
  Range("a1:h" & nlig).Sort key1:=Range("h1"), order1:=xlAscending, Header:=xlYes
  Set xrg = Range("h1:h" & nlig).Find(What:="#DIV/0!", After:=Range("h1"), LookIn:=xlFormulas, _
          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
          MatchCase:=False, SearchFormat:=False)
  If Not xrg Is Nothing Then Range("a" & xrg.Row & ":a" & nlig).EntireRow.Delete
  Range("g:h").Delete
  Application.ScreenUpdating = True

End Sub

'|¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯|
'| Ajouter la référence à la bibliothèque Microsoft Scripting Runtime (scrrun.dll) au projet ! |
'|_____________________________________________________________________________________________|

Sub toto()
Dim i&, j&, v, u(), Data(), d As New Scripting.Dictionary
ReDim t(0)
  With Me.ListObjects("DATA")
    Data = Range("DATA").Value
    For i = 1 To UBound(Data)
      v = Data(i, 2): If IsEmpty(v) Or Not IsNumeric(v) Then v = 0
      If d.Exists(CStr(Data(i, 1))) Then
        u = d(CStr(Data(i, 1)))
        ReDim Preserve u(1 + UBound(u))
        u(UBound(u)) = Array(i, v)
        d(CStr(Data(i, 1))) = u
      Else
        d.Add CStr(Data(i, 1)), Array(Array(i, v))
      End If
    Next
    If Not d Is Nothing Then
      u = d.Items
      Set d = Nothing
      For i = 0 To UBound(u)
        If UBound(u(i)) <> 0 Then
          v = u(i)(0)(1)
          For j = 1 To UBound(u(i))
            If u(i)(j)(1) > v Then v = u(i)(j)(1)
          Next
          For j = 0 To UBound(u(i))
            If v > u(i)(j)(1) Then ReDim Preserve t(1 + UBound(t)): t(UBound(t)) = u(i)(j)(0)
          Next
        End If
      Next
      With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
      For i = 1 To UBound(t)
        v = t(i)
        For j = i To UBound(t)
          If v < t(j) Then t(i) = t(j): t(j) = v: v = t(i)
        Next
        .ListRows(t(i)).Delete
      Next
      With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
    End If
  End With
End Sub