Option Explicit
Option Base  1 
Private Const dhcMissing = - 2 
Private Sub CommandButton1_Click()
'-- после выбора диапазона для сортировки при нажатии на CommandButton1 
' -- вызывается алгоритм быстрой сортировки QuickSort      
 
'-- сортировать можно как числовые значения, так     
' -- и строковые                                            
 
Dim c As Integer
Dim r As Integer
Dim c_count As Integer
Dim r_count As Integer
Dim i As Integer
Dim aSortArray() As Variant

c = Selection.Column '-- № первого столбца диапазона
r = Selection.Row      ' -- № первой строки диапазона
 
c_count = Selection.Columns.Count  '-- число столбцов в диапазоне
r_count = Selection.Rows.Count      ' -- число строк в диапазоне
 

If c_count < r_count Then
MsgBox  "выбран столбец "  &  "" & FindClm(c) & r & " : " & FindClm(c) & r + r_count - 1  & " "
ReDim Preserve aSortArray(r_count)
For i = 1  To r_count
aSortArray(i) = Cells(r + i -  1 , c).Value
Next i
Call dhQuickSort(aSortArray())
'-- Результат записываю в столбец D
For i = 1 To r_count
Cells(i, 4).Value = aSortArray(i)
Next i

ElseIf c_count > r_count Then
MsgBox "Выбрана строка " & "" & FindClm(c) & r & ":" & FindClm(c + c_count - 1) & r & ""
ReDim Preserve aSortArray(c_count)
For i = 1 To c_count
aSortArray(i) = Cells(r, c + i - 1).Value
Next i
Call dhQuickSort(aSortArray())
' -- Результат записываю в первую строку
 
For i =  1  To c_count
Cells( 1 , i).Value = aSortArray(i)
Next i
ElseIf c_count = r_count Then
MsgBox "Для сортировки выбрана одна ячейка. Подумай еще. "
End If
End Sub
Public Sub dhQuickSort(varArray As Variant, Optional lngLeft As Long = dhcMissing, Optional lngRight As Long = dhcMissing)
'----------алгоритм быстрой сортировки
 
Dim i As Long
Dim j As Long
Dim varTestVal As Variant
Dim lngMid As Long

If lngLeft = dhcMissing Then lngLeft = LBound(varArray)
If lngRight = dhcMissing Then lngRight = UBound(varArray)
If lngLeft < lngRight Then
lngMid = (lngLeft + lngRight) /  2 
varTestVal = varArray(lngMid)
i = lngLeft
j = lngRight
Do
    Do While varArray(i) < varTestVal
    i = i +  1 
    Loop
    Do While varArray(j) > varTestVal
    j = j -  1 
    Loop
    If i <= j Then
    SwapElements varArray, i, j
    i = i +  1 
    j = j -  1 
    End If
Loop Until i > j

If j <= lngMid Then
Call dhQuickSort(varArray, lngLeft, j)
Call dhQuickSort(varArray, i, lngRight)
Else
Call dhQuickSort(varArray, i, lngRight)
Call dhQuickSort(varArray, lngLeft, j)
End If
End If
End Sub
Private Sub SwapElements(varItems As Variant, lngItem1 As Long, lngItem2 As Long)
Dim varTemp As Variant
varTemp = varItems(lngItem2)
varItems(lngItem2) = varItems(lngItem1)
varItems(lngItem1) = varTemp
End Sub

Public Function FindClm(Num_Clm As Integer) As String
Dim n As Integer
If Num_Clm =  1  Then FindClm = "A "
If Num_Clm = 2  Then FindClm = "B "
If Num_Clm = 3  Then FindClm = "C "
If Num_Clm = 4  Then FindClm = "D "
If Num_Clm = 5  Then FindClm = "E "
If Num_Clm = 6  Then FindClm = "F "
If Num_Clm = 7  Then FindClm = "G "
If Num_Clm = 8  Then FindClm = "H "
If Num_Clm = 9  Then FindClm = "I "
If Num_Clm = 10  Then FindClm = "J "
If Num_Clm = 11  Then FindClm = "K "
If Num_Clm = 12  Then FindClm = "L "
If Num_Clm = 13  Then FindClm = "M "
If Num_Clm = 14  Then FindClm = "N "
If Num_Clm = 15  Then FindClm = "O "
If Num_Clm = 16  Then FindClm = "P "
If Num_Clm = 17  Then FindClm = "Q "
If Num_Clm = 18  Then FindClm = "R "
If Num_Clm = 19  Then FindClm = "S "
If Num_Clm = 20  Then FindClm = "T "
If Num_Clm = 21  Then FindClm = "U "
If Num_Clm = 22  Then FindClm = "V "
If Num_Clm = 23  Then FindClm = "W "
If Num_Clm = 24  Then FindClm = "X "
If Num_Clm = 25  Then FindClm = "Y "
If Num_Clm = 26  Then FindClm = "Z "
If Num_Clm >= 27  And Num_Clm <=  52  Then
n = Num_Clm -  26 
FindClm = "A " & FindClm(n)
End If
If Num_Clm >= 53  And Num_Clm <=  78  Then
n = Num_Clm -  26  *  2 
FindClm = "B" & FindClm(n)
End If

End Function