找到最大值

Question

roll marks
10  900
10  700
10  800
20  400
20  400
30  1700
40  1800
10  800

假设我必须找到重复滚动的最大值，例如10输出将是900（最大值900,700,800,800）。

我能够找到副本但无法找到最大值

Sub sbFindDuplicatesInColumn()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("H65000").End(xlUp).Row

    For iCntr = 5 To lastRow
    Dim intArr(1000) As Integer
    Dim iCounter
    iCounter = 0
    If Cells(iCntr, 8) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 8), Range("H1:H" & lastRow), 0)
        If iCntr <> matchFoundIndex Then

            Cells(iCntr, 10) = "Duplicate"
       End If
    End If
    Next
End Sub

Answer 1

使用cols A 和 B 中的数据时使用：

Sub dural()
   MsgBox Evaluate("MAX(IF(A2:A9=10,B2:B9))")
End Sub

这是因为 VBA 将采用数组公式。

Answer 2

我会这样尝试，使用字典作为索引并循环。它不像数组那么快，因此根据您的数据大小，它可能会很慢。您可以执行任何操作，而不是msgbox -

Sub test()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim lastrow As Long
lastrow = Range("H65000").End(xlUp).Row
Dim icntr As Long

For icntr = 5 To lastrow
Dim val As Long
val = Cells(icntr, 8)
dict(val) = 1
Next

Dim maxval As Long
For Each Key In dict.keys
    maxval = 1
    For icntr = 5 To lastrow

        If Cells(icntr, 8) = Key Then
            If Cells(icntr, 9) > maxval Then
                maxval = Cells(icntr, 9)
            End If
        End If
    Next
    MsgBox ("maximum for " & Key & " is " & maxval)

Next

End Sub

Answer 3

您可以使用自动过滤器查找重复项，然后使用小计函数查找最大值......

Sub FindMaxWithinDuplicates()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim LastRow As Long: LastRow = ws.Range("H65000").End(xlUp).Row
    Dim Tbl As Range: Set Tbl = ws.Range(Cells(5, 8), Cells(LastRow, 9))
    Dim TblCriteria As Long: TblCriteria = 10

    Dim MaxValue As Long

    With ws
        Tbl.AutoFilter Field:=1, Criteria1:=TblCriteria
        MaxValue = Application.WorksheetFunction.Subtotal(104, Tbl.Columns(2))
        Tbl.AutoFilter
    End With

    MsgBox MaxValue

End Sub