2次元配列を複数キーで昇順/降順にソートする_VBAで

VBAで、2次元配列を複数キーで昇順/降順に並べ替えしたい時の処理
配列でせずにシート書き出してからsortメソッドで出来ればその方法も楽。
でも配列でもしてみたいので。

並び替えのコード

引数の説明
myArray
並べ替える対象の2次元
arraySort
並べ替えの条件を入れた2次元配列
(kry,order)の並びで入れる　複数可
keyは条件の対象にしたい列
orderは昇順か降順を決めるBoolean値
true:昇順
false:降順
arraySortに複数条件があった時は、
上から順に再帰で処理される。
titleFlag：省略したら規定値はfalse
trueにすると配列の一行目をタイトルとして並び替えの対象としない。

Private Sub バブルソート(myArray, arraySort, Optional titleFlag As Boolean = False)
'再帰処理で2次元配列を並べ替える
'myArray：2次元配列
'arraySort(key,order)：並べ替え条件の2次元配列
'key 列数
'order true 昇順 false 降順
'arraySortで複数条件あった場合は再帰処理する
'titleFlag：省略したら規定値はfalse
'trueにすると配列の一行目をタイトルとして並び替えの対象としない

    Dim i As Long
    Dim j As Long
    
    For i = LBound(myArray, 1) To UBound(myArray, 1)
        For j = LBound(myArray) To UBound(myArray) - 1
        
            Call バブルソート再帰(j, myArray, arraySort, LBound(arraySort, 1), titleFlag)
        Next
    Next

End Sub

Private Sub バブルソート再帰(j, myArray, arraySort, cnt, titleFlag As Boolean)

    '再帰の終了条件
    If cnt > UBound(arraySort) Then Exit Sub
    
    Dim k As Long
    Dim arrayChange
    Dim myKey As Long
    Dim myOrder As Boolean
    
    myKey = arraySort(cnt, 1)
    myOrder = arraySort(cnt, 2)
    
    'titleFlagがtrueでjが最初の行の時は、
    'タイトルとして飛ばすためにj+1する
    If titleFlag And j = LBound(myArray, 1) Then
        j = j + 1
    End If
    
    If myArray(j, myKey) > myArray(j + 1, myKey) = myOrder And _
        myArray(j, myKey) <> myArray(j + 1, myKey) Then
    
        For k = LBound(myArray, 2) To UBound(myArray, 2)
            arrayChange = myArray(j, k)
            myArray(j, k) = myArray(j + 1, k)
            myArray(j + 1, k) = arrayChange
        Next
        
    ElseIf myArray(j, myKey) = myArray(j + 1, myKey) Then
    
        Call バブルソート再帰(j, myArray, arraySort, cnt + 1, titleFlag)
        
    End If

End Sub

使用する

Sub main()

    Dim array一覧表
    Dim arrayソート(1 To 1, 1 To 2)
    
    array一覧表 = ThisWorkbook.Worksheets("元表").Range("A1").CurrentRegion
    arrayソート(1, 1) = 4
    arrayソート(1, 2) = False
    
    Call バブルソート(array一覧表, arrayソート, True)
    
    ThisWorkbook.Worksheets("反映").Cells.ClearContents
    ThisWorkbook.Worksheets("反映").Range("A1").Resize(UBound(array一覧表, 1), UBound(array一覧表, 2)) = array一覧表

End Sub

シート上での並び替えをする場合

Sub setSort(targetRng As Range, arraySort条件, myHeader As Long)
'対象とした範囲を並び替える
'arraySort条件 「key order」 の2次元配列
'Order 1 昇順　2　降順
'myHeader
'xlGuess 0   見出しがあるかどうかをExcelが自動特定します。
'xlyes   1   先頭行は見出しとして、並べ替えられません。
'xlNo    2   先頭行もデータとして並べ替えられます。
    
    Dim i As Long
    
    With targetRng.Parent.Sort

        With .SortFields
            .Clear
            
            For i = LBound(arraySort条件, 1) To UBound(arraySort条件, 1)
                
                .Add key:=targetRng.Parent.Range(arraySort条件(i, 1)), Order:=arraySort条件(i, 2)
            Next

        End With

        .SetRange targetRng
        .Header = myHeader
        .Apply

    End With

End Sub