Найти три максимальных числа из выбранного диапазона в экселе

Sub srball()
tt = MsgBox("Для поиска наибольшего среднего балла задайте диапозон" & Chr(13) & Chr(10) & "(более одного элемента)" & Chr(13) & Chr(10), vbYesNo + vbQuestion, "Информационное окно")
Dim sel As Range
Set sel = ActiveWindow.RangeSelection
 
Dim m, n, i, j As Integer
If sel.Count = 1 Then
    MsgBox ("выделите диапозон," & Chr(13) & Chr(10) & "затем запустите макрос еще раз.")
    GoTo finish
End If
 
m = sel.Rows.Count
n = sel.Columns.Count
 
Dim arr() As Single
ReDim arr(1 To m, 1 To n) As Single
 
For i = 1 To m
    For j = 1 To n
    arr(i, j) = sel.Cells(i, j).Value
    Next j
Next i
 
MyMax = arr(1, 1)
For i = 1 To m
    For j = 1 To n
    If arr(i, j) > MyMax Then MyMax = arr(i, j)
    Next j
Next i
 
MyMax2 = arr(1, 1)
For i = 1 To m
    For j = 1 To n
    If arr(i, j) > MyMax2 & arr(i, j) < MyMax Then MyMax2 = arr(i, j)
    Next j
Next i
 
MyMax3 = arr(1, 1)
For i = 1 To m
    For j = 1 To n
    If arr(i, j) > MyMax3 & arr(i, j) < MyMax2 Then MyMax3 = arr(i, j)
    Next j
Next i
 
MsgBox ("максимальное значение1:" & MyMax)
MsgBox ("максимальное значение2:" & MyMax2)
MsgBox ("максимальное значение3:" & MyMax3)
Cells(m + 3, n + 2).Value = MyMax
Cells(m + 4, n + 2).Value = MyMax2
Cells(m + 5, n + 2).Value = MyMax3
finish:
End Sub

Sub srball()
tt = MsgBox("Для поиска наибольшего среднего балла задайте диапозон" & Chr(13) & Chr(10) & "(более одного элемента)" & Chr(13) & Chr(10), vbYesNo + vbQuestion, "Информационное окно")
Dim sel As Range
Set sel = ActiveWindow.RangeSelection
 
Dim m, n, i, j As Integer
If sel.Count = 1 Then
    MsgBox ("выделите диапозон," & Chr(13) & Chr(10) & "затем запустите макрос еще раз.")
    GoTo finish
End If
 
m = sel.Rows.Count
n = sel.Columns.Count
 
Dim arr() As Single, arr1() As Single, temp_i As Integer
ReDim arr(1 To m, 1 To n) , arr1(1 To m * n)
 
For i = 1 To m
    For j = 1 To n
        arr(i, j) = sel.Cells(i, j).Value
        temp_i = temp_i + 1
        arr1(temp_i) = arr(i, j)
    Next j
Next i
 
BubbleSort arr1
 
MsgBox ("максимальное значение1:" & arr1(1))
MsgBox ("максимальное значение2:" & arr1(2))
MsgBox ("максимальное значение3:" & arr1(3))
Cells(m + 3, n + 2).Value = arr1(1)
Cells(m + 4, n + 2).Value = arr1(2)
Cells(m + 5, n + 2).Value = arr1(3)
finish:
End Sub
 
Public Sub BubbleSort(ByRef arr() As Single)
    Dim i As Integer, j As Integer, tmp As Single
     For i = 1 To UBound(arr)
        For j = 1 To UBound(arr) - i - 1
            If arr(j) < arr(j + 1) Then
                tmp = arr(j)
                arr(j) = arr(j + 1)
                arr(j + 1) = tmp
            End If
        Next j
    Next i
End Sub