Finding highest and subsequent values in a range

问题

I have the below code which is supposed to find the 1st, 2nd, 3rd, and 4th highest values in a range.

It is currently very basic, and I have it providing the values in a MsgBox so I can confirm it is working.

However, it only finds the highest and second highest values. The third and fourth values are returned back as 0. What am I missing?

Sub Macro1()

Dim rng As Range, cell As Range
Dim firstVal As Double, secondVal As Double, thirdVal As Double, fourthVal As Double

Set rng = [C4:C16]

For Each cell In rng
    If cell.Value > firstVal Then firstVal = cell.Value
    If cell.Value > secondVal And cell.Value < firstVal Then secondVal = 
    cell.Value
    If cell.Value > thirdVal And cell.Value < secondVal Then thirdVal = 
    cell.Value
    If cell.Value > fourthVal And cell.Value < thirdVal Then fourthVal = 
    cell.Value
Next cell

MsgBox "First Highest Value is " & firstVal
MsgBox "Second Highest Value is " & secondVal
MsgBox "Third Highest Value is " & thirdVal
MsgBox "Fourth Highest Value is " & fourthVal

End Sub

回答1:

Use Application.WorksheetFunction.Large():

Sub Macro1()

Dim rng As Range, cell As Range
Dim firstVal As Double, secondVal As Double, thirdVal As Double, fourthVal As Double

Set rng = [C4:C16]


firstVal = Application.WorksheetFunction.Large(rng,1)
secondVal = Application.WorksheetFunction.Large(rng,2)        
thirdVal = Application.WorksheetFunction.Large(rng,3)
fourthVal = Application.WorksheetFunction.Large(rng,4)

MsgBox "First Highest Value is " & firstVal
MsgBox "Second Highest Value is " & secondVal
MsgBox "Third Highest Value is " & thirdVal
MsgBox "Fourth Highest Value is " & fourthVal

End Sub

回答2:

You have a better method suggested by Scott Craner above. However, to answer your question, you are only returning a limited number of values because you are overwriting the values without shifting the original values to a lower rank.

Dim myVALs As Variant
myVALs = Array(0, 0, 0, 0, 0)

For Each cell In rng
    Select Case True
        Case cell.Value2 > myVALs(0)
            myVALs(4) = myVALs(3)
            myVALs(3) = myVALs(2)
            myVALs(2) = myVALs(1)
            myVALs(1) = myVALs(0)
            myVALs(0) = cell.Value2
        Case cell.Value2 > myVALs(1)
            myVALs(4) = myVALs(3)
            myVALs(3) = myVALs(2)
            myVALs(2) = myVALs(1)
            myVALs(1) = cell.Value2
        Case cell.Value2 > myVALs(2)
            myVALs(4) = myVALs(3)
            myVALs(3) = myVALs(2)
            myVALs(2) = cell.Value2
        Case cell.Value2 > myVALs(3)
            myVALs(4) = myVALs(3)
            myVALs(3) = cell.Value2
        Case cell.Value2 > myVALs(4)
            myVALs(4) = cell.Value2
        Case Else
            'do nothing
    End Select
Next cell

Debug.Print "first: " & myVALs(0)
Debug.Print "second: " & myVALs(1)
Debug.Print "third: " & myVALs(2)
Debug.Print "fourth: " & myVALs(3)
Debug.Print "fifth: " & myVALs(4)

来源：https://stackoverflow.com/questions/44551470/finding-highest-and-subsequent-values-in-a-range

标签

excel

vba

worksheet-function