删除重复的行，但保留某个单元格中具有最高值的整行

Question

我有一个包含17列（A列到S列）的excel工作表。A列包含ID号，C列是日期列，F列包含时间格式的值（hh： mm）。对于同一个日期/天，一些ID号在F列中包含两个值-通常是一个高数字（多小时和分钟）和一个低数字（几分钟）。如果有这样的重复，我希望从工作表中删除包含F列中低值的整行。

我尝试了Excel的“板载”删除重复项功能，但没有成功。然后我遇到了这段VBA代码，它删除了包含最高值的整个重复行：

Option Explicit

Sub RemoveDuplicatesKeepMin()
    Dim r As Integer, r2 As Integer, i As Integer
    Dim rng As Range
    Dim NextVal As Double

    r = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A2:C" & r)
    rng.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    r2 = 2
    For i = 2 To r
        If Not NextVal = Range("A" & i) Then
            Range(Cells(i, 1), Cells(i, 2)).Copy Destination:=Range("D" & r2)
        r2 = r2 + 1
        NextVal = Range("A" & i + 1)
    End If
Next
rng.Delete Shift:=xlShiftToLeft
Set rng = Nothing
End Sub

我不完全确定我是否理解这背后的逻辑，但我猜这可以作为一个起点（颠倒逻辑并添加新的限制（如果在同一天）。如果我将顺序从升序更改为降序，则需要取最高值。但我不确定如何设置额外的限制（日限制）。

谢谢！

Answer 1

这里，我对您的问题的方法：

Public Sub deleteDuplicate()

    Dim row As Integer

    'Set the start row
    row = 2

    With Sheets("sheetname")

        'Loop until ID cell is blank
        Do While .Range("A" & row) <> ""

            innerRow = 1

            'Re-loop until ID cell is blank for checking
            Do While .Range("A" & innerRow) <> ""

                'If ID and date are equal
                If row <> innerRow And .Range("A" & row) = .Range("A" & innerRow) And .Range("C" & row) = .Range("C" & innerRow) Then

                    If .Range("F" & row) < .Range("F" & innerRow) Then

                        .Rows(row).Delete

                        row = row - 1

                        Exit Do

                    Else

                        .Rows(innerRow).Delete

                    End If

                End If

                'Increase inner looping row
                innerRow = innerRow + 1

            Loop

            'Increase row
            row = row + 1

        Loop

    End With

End Sub