VBA - 查找重复并比较其中哪一个是最高的

Question

嘿，我正在尝试过滤/匹配我的工作表是否有重复项，我有两个标准:

在 (column B) 中的任意位置查找重复项, 如果在 (column E) 中有重复设置“适用”在与找到的重复项相同的行上。

(column B) 中的重复项之一(column C) 中数字最高的(0-10 之间的数字)在 (column E) 中仍应具有“适用”但最小的数字应该在 (column E) 中被“删除”反而。我希望我看起来像这样:

Sub FindDUB()
    Dim lastRow As Long 'Declaring the lastRow variable

    Dim MatchReqprodID As Long 'store the match index values of the given value
    Dim MatchRevision As Double 'store the match index values of the given value

    Dim RevisionColumnCompare As Integer 'Column number in sheet
    Dim ReqprodIDColumnCompare As Integer 'Column number in sheet

    Dim CompareReqprodID As Long 'Compare is to loop through all the records in the column using For loop
    Dim CompareRevision As Long 'Compare is to loop through all the records in the column using For loop

    RevisionColumnCompare = 3 'C
    ReqprodIDColumnCompare = 2 'B

    'Finding the last row in Reqprod ID
    lastRow = Range("B" & Rows.Count).End(xlUp).Row

    'looping through the Reqprod ID column
    For CompareReqprodID = 1 To lastRow



        If Cells(CompareReqprodID, ReqprodIDColumnCompare) <> "" Then 'skipping if it is blank.

            'getting match index number for the value of the cell
            MatchReqprodID = WorksheetFunction.Match(Cells(CompareReqprodID, ReqprodIDColumnCompare), Range("B1:B" & lastRow), 0)
            'MatchRevision = Application.WorksheetFunction.Large(RevisionColumnCompare, 1)

            'if the match index is not equals to current row number, then it is a duplicate value
            If CompareReqprodID <> MatchReqprodID Then
                'If CompareRevision <> MatchRevision Then
                   ' Cells(CompareReqprodID, ApplicableColumn) = "Removed"
                   ' Cells(MatchReqprodID, ApplicableColumn) = "Applicable"
                'Else
                    Cells(CompareReqprodID, ApplicableColumn) = "Applicable"
                    Cells(MatchReqprodID, ApplicableColumn) = "Removed"
                'End If

            End If

        End If

    Next

End Sub

这段代码不稳定，现在不能用，以前用过 if MatchRevision和 If CompareRevision <> MatchRevision Then功能被删除。然后我可以找到重复项，但不指出其中哪一个具有最高修订版。

所以我的问题是，如果我如何过滤我的工作表，找到重复项并查看哪些重复项具有最高的“修订”值，并将最高设置为“适用”，将最低设置为“已删除” ”在“状态”中。谢谢!

Answer 1

Sub FindDUB()

    Dim lastRow As Long
    Dim currentRow As Long
    Dim innerRow As Long
    Dim frequency As Integer
    Dim currentID As Long
    Dim currentValue As Long
    Dim firstValue As Long

    lastRow = ThisWorkbook.Worksheets("Tabelle1").Range("B" & Rows.Count).End(xlUp).Row

    For currentRow = 1 To lastRow
        frequency = Application.WorksheetFunction.CountIf(Range("B:B"), Range("B" & currentRow).Value)
        If frequency > 1 Then
            Range("E" & currentRow).Value = "Removed"
        Else
        End If
    Next currentRow

    For currentRow = 1 To lastRow
        If Range("E" & currentRow).Value = "Removed" Or Range("E" & currentRow).Value = "Applicable" Then

            currentID = CLng(Range("B" & currentRow).Value)
            firstValue = CLng(Range("C" & currentRow).Value)

            For innerRow = currentRow To lastRow
                If CLng(Range("B" & innerRow).Value) = currentID Then
                    If CLng(Range("C" & innerRow).Value) < firstValue Then
                        Range("E" & currentRow).Value = "Applicable"
                        Range("E" & innerRow).Value = "Removed"
                    ElseIf CLng(Range("C" & innerRow).Value) > firstValue Then
                        Range("E" & currentRow).Value = "Removed"
                        Range("E" & innerRow).Value = "Applicable"
                    Else
                    End If
                Else
                End If
            Next innerRow

        Else
        End If

    Next currentRow


End Sub