查找范围内的最高值和后续值答案

【问题标题】：Finding highest and subsequent values in a range查找范围内的最高值和后续值
【发布时间】：2017-06-14 17:49:16
【问题描述】：

我有下面的代码，它应该在一个范围内找到第 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

【问题讨论】：

另一种方法是对范围进行排序，然后获取您的值:)

标签： excel vba worksheet-function

【解决方案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

【讨论】：

@Scott Cramer 我再添加一个警告......我真正想做的是将字符串存储在（第 1、第 2、 3rd, 4th) 变量中的值。所以偏移（0，-1）。如何正确获取偏移量？
@sbagnato 然后使用 Match 在列表中查找值并使用 rng(i).offset(0,-1) 其中 i 是 Application.WorksheetFunction.Match 返回的 long。尝试使用这些提示，如果您无法使其发挥作用，请提出一个新问题。
我有一个关于这个话题的问题。我还想获得最高值的范围参考。你能给我一个建议吗？谢谢。
请用您自己的问题和所需信息创建您自己的帖子。 @MrZH6 对一个已有近 2 年历史的问题提出新问题并不是获得问题答案的正确方法。

【解决方案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)

【讨论】：

【解决方案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

【讨论】：