find最大值

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

假设我必须find重复卷的最大值，比如10个输出将是900（最大900,700,800,800）。

我能够find重复，但无法find最大值。

 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

我会试试这种方式，使用字典作为索引和循环。 它不如数组快，所以根据你的数据大小，它可能会很慢。 你可以做任何事情，而不是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 2

使用列A和B中的数据使用：

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

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

Answer 3

您可以使用自动筛选器来查找重复项，然后使用小计functionfind最大值…

 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