'----------------------------------------------------------------------------------------------------------------------------
' Данная функция сортирует массив по заданному направлению по указанному столбцу, по умолчанию направление по убыванию,
' но если в качестве 3ей переменной указать иное значение (не desc) то массив будет отсортирован по возрастанию
' Для использования функции должен быть объявлен непустой массив, 2ая переменная номер столбца,3я номер опционально направление
' в случае успешного выполнения функция принимает значение TRUE иначе FALSE
'----------------------------------------------------------------------------------------------------------------------------
Public Function SortArrayBubble(ByRef InArr() As Variant, ByVal ColNum As Integer, Optional direct As String = "desc") As Boolean
    SortArrayBubble = False
On Error GoTo endt

If ColNum <= UBound(InArr,  2 ) Then
Dim TempArr() As Variant
ReDim Preserve TempArr( 1 , UBound(InArr,  2 )) As Variant

If direct = "desc" Then
    For I =  2  To UBound(InArr,  1 )
        For J = UBound(InArr,  1 ) To I Step - 1 
        If UCase(InArr(J -  1 , ColNum)) < UCase(InArr(J, ColNum)) Then
            For K =  1  To UBound(InArr,  2 )
                TempArr( 1 , K) = InArr(J -  1 , K)
                InArr(J -  1 , K) = InArr(J, K)
                InArr(J, K) = TempArr( 1 , K)
            Next K
        End If
        
        Next J
    Next I

Else
    For I =  2  To UBound(InArr,  1 )
        For J = UBound(InArr,  1 ) To I Step - 1 
        If InArr(J -  1 , ColNum) > InArr(J, ColNum) Then
            For K =  1  To UBound(InArr,  2 )
                TempArr( 1 , K) = InArr(J -  1 , K)
                InArr(J -  1 , K) = InArr(J, K)
                InArr(J, K) = TempArr( 1 , K)
            Next K
        End If
        
        Next J
    Next I
End If
Erase TempArr
SortArrayBubble = True

End If
endt:

End Function

Public Sub SORTING()
Dim InArr( 1  To  21 ,  1  To  3 ) As Variant

For I =  1  To UBound(InArr,  1 )
For J =  1  To UBound(InArr,  2 )
InArr(I, J) = Cells(I, J)
Next J
Next I



fgt = SortArrayBubble(InArr,  3 , "desc")

If ArrayIsEmpty(InArr) = False Then
For I =  1  To UBound(InArr,  1 )
For J =  1  To UBound(InArr,  2 )
Cells(I, J +  5 ) = InArr(I, J)
Next J
Next I
End If

fgt = SortArrayBubble(InArr,  2 , "desc")


If ArrayIsEmpty(InArr) = False Then
For I =  1  To UBound(InArr,  1 )
For J =  1  To UBound(InArr,  2 )
Cells(I, J +  10 ) = InArr(I, J)
Next J

Next I
End If

End Sub

If UCase(InArr(J -  1 , ColNum)) < UCase(InArr(J, ColNum)) Then