Из массива 10 чисел, вывести на экран 3 наибольших числа

Option Explicit
 
Private Sub main()
    Const Levels = 3
    
    Randomize
    Dim mass(1000000) As Long: Dim i&
    For i = LBound(mass) To UBound(mass)
        mass(i) = Int(Rnd * 2001) - 1000
    Next
    
    Dim sortAr() As Long
    sortAr = mass
 
    Dim perf As New Perfomance
 
    perf.Run "QSort"
 
    Call QSort(sortAr(), LBound(sortAr), UBound(sortAr))
 
    perf.StopCounter
 
    For i = UBound(sortAr) To UBound(sortAr) - Levels + 1 Step -1
        Debug.Print sortAr(i)
    Next
    
    perf.Run "MyMax"
    
    Dim max&(), pos&()
    Call FindMAx(mass, max, pos, Levels)
    
    perf.StopCounter
    
    Dim n&
    For n = 1 To UBound(max)
        Debug.Print max(n) & " on pos " & pos(n)
    Next
    
End Sub
 
Public Sub FindMAx(ByRef Ar() As Long, ByRef max() As Long, ByRef pos() As Long, ByVal Steps As Long)
    Dim tmpAr(), n&, thisStep&, InitPos&, max_() As Variant
    
    ReDim Preserve max_(1 To Steps)
    ReDim Preserve max(1 To Steps)
    ReDim Preserve pos(1 To Steps)
    
    ReDim tmpAr(UBound(Ar))
    
    For n = LBound(Ar) To UBound(Ar) 'Copy Long array into Variant Type Array
        tmpAr(n) = Ar(n)
    Next
    
    InitPos = LBound(Ar)
    
    For thisStep = 1 To Steps
    
        max_(thisStep) = tmpAr(InitPos)
        pos(thisStep) = InitPos
        
        For n = LBound(Ar) + 1 To UBound(Ar)
            If tmpAr(n) > max_(thisStep) Then
                If Not IsNull(tmpAr(n)) Then
                    max_(thisStep) = tmpAr(n)
                    pos(thisStep) = n
                End If
                
            ElseIf IsNull(max_(thisStep)) Then
                Do
                    InitPos = InitPos + 1 'Shift to the first not null element
                Loop While IsNull(tmpAr(InitPos)) And InitPos < UBound(Ar)
                
                If Not IsNull(tmpAr(n)) Then
                    max_(thisStep) = tmpAr(n)
                    pos(thisStep) = n
                End If
            End If
        Next
        tmpAr(pos(thisStep)) = Null
    Next
    
    For n = 1 To Steps 'Copy Variant array into Long type array
        max(n) = max_(n)
    Next
    
End Sub
 
Sub QSort(strArray&(), intBottom As Long, intTop As Long)
  Dim strPivot As String, strTemp As String
  Dim intBottomTemp As Long, intTopTemp As Long
 
  intBottomTemp = intBottom
  intTopTemp = intTop
 
  strPivot = strArray((intBottom + intTop) \ 2)
 
  While (intBottomTemp <= intTopTemp)
    While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
      intBottomTemp = intBottomTemp + 1
    Wend
    
    While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
      intTopTemp = intTopTemp - 1
    Wend
    
    If intBottomTemp < intTopTemp Then
      strTemp = strArray(intBottomTemp)
      strArray(intBottomTemp) = strArray(intTopTemp)
      strArray(intTopTemp) = strTemp
    End If
    
    If intBottomTemp <= intTopTemp Then
      intBottomTemp = intBottomTemp + 1
      intTopTemp = intTopTemp - 1
    End If
  Wend
  If (intBottom < intTopTemp) Then QSort strArray, intBottom, intTopTemp
  If (intBottomTemp < intTop) Then QSort strArray, intBottomTemp, intTop
End Sub