如何删除重复的行并仅在Excel中保留最高值？

Public Sub DelDupes() Dim xFilterRg As Range Dim xCriteriaRg As Range Dim xAddress As String Dim xSUpdate As Boolean On Error Resume Next xAddress = Application.ActiveWindow.RangeSelection.Address Set xFilterRg = Application.InputBox("Please select a range:", "Kutools for Excel", xAddress, , , , , 8) If xFilterRg Is Nothing Then Exit Sub Set xFilterRg = Application.Intersect(ActiveSheet.UsedRange, xFilterRg) If xFilterRg Is Nothing Then Exit Sub On Error GoTo 0 xSUpdate = Application.ScreenUpdating Application.ScreenUpdating = False Set xCriteriaRg = ActiveSheet.Cells(1, xFilterRg.Column + xFilterRg.Columns.Count).Resize(2) xCriteriaRg.Resize(1).Offset(1).Formula = "=COUNTIF(" & xFilterRg(2, 1).Address & ":" & _ xFilterRg(2, 1).Address(False, False) & "," & _ xFilterRg(2, 1).Address(False, False) & ")>1" With xFilterRg .Sort key1:=xFilterRg.Cells(1, 1).Offset(0, 1), order1:=xlDescending, Header:=xlYes .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=xCriteriaRg .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete .Parent.ShowAllData End With xCriteriaRg.Clear Application.ScreenUpdating = xSUpdate End Sub