Excel VBA - 範囲内の最高値と次の値の検索

Question

範囲内の1,2,3,4番目の最高値を見つけるはずの以下のコードがあります。

現在のところ非常に基本的なもので、MsgBoxの値を提供しているので、動作していることを確認できます。

ただし、最も高い値と2番目に高い値しか検出されません。 3番目と4番目の値は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)