Question

我有以下代码，可以找到范围内的第1，第2，第3和第4个最高值。

目前它非常基础，我在MsgBox中提供了值，所以我可以确认它是否正常工作。

但是，它只能找到最高和第二高的值。第三个和第四个值返回为0.我缺少什么？

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

Answer 1

使用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

Answer 2

上面的Scott Craner建议您使用更好的方法。但是，要回答您的问题，您只返回有限数量的值，因为您覆盖了值而没有将原始值移到较低的等级。

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)

Answer 3

Excel wroksheetfuntion 将是该任务的更好选择。这将允许用户选择范围并将它们发布在任何包含无效数据的范围内。可以为 Top4 值声明另一种 Double 数据类型，也可以更新相同的 msgbox。这将避免宏中的任何类型的错误。

Sub top_three()

Dim Area As Range
Dim Tone As Double, Ttwo As Double, Tthree As Double

On Error GoTo Skip

Set Area = Excel.Application.InputBox("Select the Range", "Data Visulaization", 
Type:=8)

If Excel.Application.WorksheetFunction.Count(Area) >= 3 Then

Tone = Excel.WorksheetFunction.Large(Area, 1)
Ttwo = Excel.WorksheetFunction.Large(Area, 2)
Tthree = Excel.WorksheetFunction.Large(Area, 3)

VBA.Interaction.MsgBox "Top 1: " & Tone & VBA.Constants.vbNewLine & _
"Top 2: " & Ttwo & VBA.Constants.vbNewLine & "Top 3:" & Tthree, Title:= _
"Top 3 values"

Else

VBA.Interaction.MsgBox "No Enough Data type to perform the task", vbInformation

End If

Skip:

End Sub

Excel VBA - 查找范围中的最高值和后续值

3 个答案: