VBAにて、名前別に昇順にしたい

Question

VBAにて名前別に、項目Cを基準に昇順にしたいです。

[元データ例]

[望む結果]

以下、まだ昇順のコードまではかけていません。

Sub 昇順()
 
    Dim 配列
    Dim 行(200)
    Dim r As Long
    Dim p As Integer
    Dim 名前(100000) As Variant
    
    Dim 最終行 As Long
    
    Application.ScreenUpdating = False
    
   Sheets("sheet1").Select
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row
    配列 = Range("A1:D" & 最終行)
    
    For r = 1 To 最終行
        名前(r) = 配列(r, 1)

        If 名前(r) <> 名前(r - 1) Then
            p = p + 1
            行(p) = r
        End If
        If r = 最終行 Then
            p = p + 1
            行(p) = r
        End If
    Next
    
    Application.ScreenUpdating = True

 End Sub

よろしくお願いいたします。

Answer 1

ソートはexcelの機能を使うと、シンプルかつ高速にできます。

Sub 昇順()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    
    Dim rng As Range
    Set rng = ws.Range("A1").CurrentRegion 'データ範囲取得
    
    'CustomOrder用文字列生成
    Dim c As Range, CtmOrd As String
    For Each c In rng.Columns(1).Cells
        If InStr(CtmOrd & ",", "," & c.Value & ",") < 1 Then
            CtmOrd = CtmOrd & "," & c.Value
        End If
    Next
    CtmOrd = Mid(CtmOrd, 2)

    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rng.Columns(1), CustomOrder:=CVar(CtmOrd)
        .SortFields.Add Key:=rng.Columns(4)
        .SetRange rng
        .Header = xlYes
        .Apply
    End With
 End Sub

Comments

[Miii]

ご回答くださりありがとうございます！
短いコードで実現できるのですね！
２つ質問です。
1.実行すると、見出し？部分が一番下にくるので上に固定する方法
2.名前を追加すると（例:石田）、昇順が機能しない。
（マクロ側のCustomOrder:の名前にも石田を追加しているのですが、
実行してもうまく昇順になりません。）
ご教授いただけると幸いです。

[Miii]

1について、先ほど再度実行したところ、
見出し？部分がそのままで昇順されましたが、
なぜ出来なかったのかわかりません。
2については、石田の部分だけ、やはり昇順になりません。

[Miii]

２について、
手入力したデータだとうまくいかないことがわかったので、調べてみたところ、並べ替えオプションの「ふりがなを使わない」設定をしたところ、解決しました！ありがとうございます！

[hatena19]

データを追加したり編集しても、コードを修正する必要がないように回答のコードを改善しました。
ご確認ください。

[Miii]

お気遣いくださりありがとうございます＾＾
助かりました♪