Sletning af højeste værdi ved dubletter

Prøv med denne makro:

Sub Slet()
Dim LastRow, X As Long
LastRow = Cells(65356, 1).End(xlUp).Row
For X = 2 To LastRow
If WorksheetFunction.CountIf(Range("C:C"), Cells(X, 3)) > 1 And WorksheetFunction.MaxIfs(Range("B:B"), Range("C:C"), Cells(X, 3)) = Cells(X, 2) Then
Cells(X, 2).ClearContents
End If
Next
End Sub

@jens48 - tak for dit forslag. Hvis jeg kører denne makro, så sletter den begge varenumre i kolonne B og beholder kun det mindste varenummer, hvis der er 3 dubletter eller derover.

Måske som her:

https://www.dropbox.com/scl/fi/nhq3zq5qmisn9dqvhx1at/Sletning-af-dubletter_2.xlsx?rlkey=3hh5vo19iot7mostzgvskimh7&dl=0

Ups, der skal først testes og så slettes. I denne har jeg gjort brug af kolonne D. hvis det ikke er en mulighed, kan det sikkert klares med sortering før testen.

Sub Slet()
Dim LastRow, X As Long
LastRow = Cells(65356, 1).End(xlUp).Row
For X = 2 To LastRow
If WorksheetFunction.CountIf(Range("C:C"), Cells(X, 3)) > 1 And WorksheetFunction.MinIfs(Range("B:B"), Range("C:C"), Cells(X, 3)) <> Cells(X, 2) Then
Cells(X, 4) = 1
End If
Next
For X = 2 To LastRow
If Cells(X, 4) = 1 Then Cells(X, 2) = ""
Next
Range("d:d").ClearContents
End Sub

@jens48 - ja da, det virker!! Tak for hjælpen:-)