VBA 降順で並び替える。

Question

以下のコードで、画像の通り降順でプログラムを組めたのですが、
その逆の、セルの6行目から１行目に向かって、降順でコードはどうすればできますか？

Sub test4()

Dim a, b, c, d, e, f, g, h, i, p As Long
Dim min As Long
Dim gyo As Long
Dim hako As Long


a = 1

Do Until Cells(a, 1) = ""
 a = a + 1
 Loop
 b = a - 1                       '最終行'

  
For c = 1 To b                  '変数cに最終行まで'
Cells(c, 2) = Cells(c, 1)       '(c,2)に(c,1)を代入'
Next                              'A1の数値をB2にコピー'



For p = 1 To b - 1               '変数pに最終行までの繰り返し'
i = p + 1                        'iにp + 1 で、2 To bと同じ意味'
h = i + 1                          'iに　+1'

If Cells(p, 2) > Cells(i, 2) Then  '(p,2)と(i,2)で、(p,2)が大きい場合'
 min = Cells(p, 2)                  'minに(p,2)を代入'
 gyo = p                            'gyoにpを代入'
 Else                               'そうじゃなければ'
 min = Cells(i, 2)                  'minに(i,2)を代入'
 gyo = i                            'gyoにiを代入'
 End If
 
 
 For f = h To b
 If min < Cells(f, 2) Then
 gyo = f
 min = Cells(f, 2)
 
 End If
 Next
 
 hako = Cells(p, 2)
 Cells(p, 2) = min
 Cells(gyo, 2) = hako
 
 Next
 
End Sub

Answer 1

ソートは検索すればいろいろなアルゴリズムがみつかります。バブルソートとか・・・・
提示のコードは選択ソートに分類されるものだと思いますが、いろいろ無駄がおおいようです。

参考までに、選択ソートによる実装例です。
選択ソート - Wikipedia

Sub Sample()
    '事前準備
    Dim r As Range
    Set r = Range("A1").CurrentRegion
    r.Copy Range("B1") 'A列のデータをB列にコピー
    
    Dim lastRow As Long
    lastRow = r.Rows.Count '最終行

    
    '選択法によるソート
    Dim i As Long, j As Long, s As Long, t As Long, max As Long
    For i = 1 To lastRow - 1
        max = Cells(i, 2)
        s = i
        '対象セル以降の最大値セルを探索
        For j = i + 1 To lastRow
            If Cells(j, 2) > max Then
                max = Cells(j, 2)
                s = j
            End If
        Next j
        '対象セルと最小値セルを入れ替え
        t = Cells(i, 2)
        Cells(i, 2) = Cells(s, 2)
        Cells(s, 2) = t
    Next i
 
End Sub

上記で降順にならびます。
昇順にしたい場合は、途中の不等号の向きを逆にすればOKです。

Answer 2

詳しくは見ていませんが、大小判定の箇所を2か所逆にしました。
これで、セルの6行目から１行目に向かって、降順に表示されました。
なお、minの文字はmaxに変えたほうが、良いかもしれません。

Sub test4()

Dim a, b, c, d, e, f, g, h, i, p As Long
Dim min As Long
Dim gyo As Long
Dim hako As Long


a = 1

Do Until Cells(a, 1) = ""
 a = a + 1
 Loop
 b = a - 1                       '最終行'

  
For c = 1 To b                  '変数cに最終行まで'
Cells(c, 2) = Cells(c, 1)       '(c,2)に(c,1)を代入'
Next                              'A1の数値をB2にコピー'



For p = 1 To b - 1               '変数pに最終行までの繰り返し'
i = p + 1                        'iにp + 1 で、2 To bと同じ意味'
h = i + 1                          'iに　+1'

'If Cells(p, 2) > Cells(i, 2) Then  '(p,2)と(i,2)で、(p,2)が大きい場合'
If Cells(p, 2) < Cells(i, 2) Then  '(p,2)と(i,2)で、(p,2)が大きい場合'
 min = Cells(p, 2)                  'minに(p,2)を代入'
 gyo = p                            'gyoにpを代入'
 Else                               'そうじゃなければ'
 min = Cells(i, 2)                  'minに(i,2)を代入'
 gyo = i                            'gyoにiを代入'
 End If
 
 
 For f = h To b
 'If min < Cells(f, 2) Then
 If min > Cells(f, 2) Then
 gyo = f
 min = Cells(f, 2)
 
 End If
 Next
 
 hako = Cells(p, 2)
 Cells(p, 2) = min
 Cells(gyo, 2) = hako
 
 Next
 
End Sub