Sub example_01() '1-мерный массив
With Sheets("Sheet1")
 With .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
 .Value = Application.Transpose(ShellSort11(Application.Transpose(.Value)))
 End With
End With
End Sub

Function ShellSort11(x) '*** для 1-мерного массива
Dim Limit As Long, Switch As Long, i As Long, j As Long
Dim tmp
j = (UBound(x) - LBound(x) + 1) \ 2
Do While j > 0
 Limit = UBound(x) - j
 Do
 Switch = LBound(x) - 1
 For i = LBound(x) To Limit
 If x(i) > x(i + j) Then 'по возрастанию
' If x(i) < x(i + j) Then 'по убыванию
 tmp = x(i): x(i) = x(i + j)
 x(i + j) = tmp: Switch = i
 End If
 Next
 Limit = Switch - j
 Loop While Switch >= LBound(x)
 j = j \ 2
Loop
ShellSort11 = x
End Function

Sub example_02() '2-мерный массив
Dim tm!: tm = Timer
With Sheets("Sheet1")
 With .Range("A1:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
 .Value = ShellSort22(.Value, 2)
 End With
End With
End Sub

Function ShellSort22(x, k As Long) '*** сортируем 2-мерный массив x по столбцу k
Dim Limit As Long, Switch As Long, i&, j&, u&
Dim ubx&, t
ubx = UBound(x, 2): j = (UBound(x) - LBound(x) + 1) \ 2
Do While j > 0
 Limit = UBound(x) - j
 Do
 Switch = LBound(x) - 1
 For i = LBound(x) To Limit
 If x(i, k) > x(i + j, k) Then 'по возрастанию
' If x(i, k) < x(i + j, k) Then 'по убыванию
 For u = LBound(x) To ubx
 t = x(i, u)
 x(i, u) = x(i + j, u)
 x(i + j, u) = t
 Next
 Switch = i
 End If
 Next
 Limit = Switch - j
 Loop While Switch >= LBound(x)
 j = j \ 2
Loop: ShellSort22 = x
End Function