4項目以上のソート

VBA にもソートを行う関数は存在します。しかし、複数項目をキーにしたい場合、最大3つまでしか使う事ができません。4項目以上でソートを行う方法を考えたので、メモしておきます。

サンプルソースは1行目に見出しが存在する、5項目からなる表を想定します(下図、サンプル参照)。これを、都道府県、市区町村、番地、戦闘力の順に、すべて昇順でソートするとします。なお、サンプルに意味はありませんのであしからず。

都道府県 市区町村 番地 名前 戦闘力
埼玉県 さいたま市 1 小野塚 5
埼玉県 さいたま市 3 15
埼玉県 さいたま市 3 12
東京都 千代田区 1 博麗 20
埼玉県 さいたま市 1 蓬莱山 10
埼玉県 さいたま市 2 上白沢 20
東京都 墨田区 3 霧雨 18
Sub MySort()
    Dim i As Integer                ' 行カウンタ
    Dim index As Integer            ' グループの先頭位置インデックス
    Dim lastRow As Integer          ' 最終行
    
    ' まず、3項目でソート
    Worksheets("対象シート").range(Cells(2, 1), Cells(range("A65536").End(xlUp).Row, 5)) _
        .Sort key1:=range("A2"), order1:=xlAscending, _
        key2:=range("B2"), order2:=xlAscending, _
        key3:=range("C2"), order3:=xlAscending
    
    ' 4項目目のソート
    i = 2
    index = 2
    lastRow = range("A65536").End(xlUp).Row ' 先に最終行は保存しておく(計算コスト軽減)
    While (i < lastRow)
        ' 先の3項目が同じ値である限り読み飛ばす
        If Cells(i, 1).Value <> Cells(i + 1, 1).Value Or _
            Cells(i, 2).Value <> Cells(i + 1, 2).Value Or _
            Cells(i, 3).Value <> Cells(i + 1, 3).Value Then
            ' 先の3項目が同じグループ内で、4項目目でソート
            Worksheets("対象シート").range(Cells(index, 1), Cells(i, 5)) _
                .Sort key1:=range("E2"), order1:=xlAscending
            ' インデックスを現在の値へ
            index = i + 1
        End If
        ' i を加算
        i = i + 1
    Wend
End Sub

つまり、前もって優先度順に3つの値でソートしたものを、そのグループ毎にさらにソートするということです。その気になれば7項目以上のソートも同じ手順でできますが、そこまで必要なケースは少ないでしょう。
と、仕事で必要になったのでこれで解決したのですが、もし他の方法や考え違いがあるようであればご教授頂けると幸いです。