VBAの配列を挿入ソートで並べ替え

VBAで配列を使うことがあります。

Dim sArray()

このときに配列の並び順を昇順や降順に変えたいことがあります。

それを挿入ソートで行う場合のコードです。

以下のマクロは配列の内容を昇順（小さい順）に並べなおします。

挿入ソートは単純挿入法という言い方もされます。

同じ値の順序がソート前と変わらない安定ソートです。

ソート処理の実行時間はO(n^2)と速いとは言えないのですが、ある程度整列している状態であれば高速に処理できます。

その性質を利用して、クイックソートとの組み合わせを行うことがあります。

クイックソートは一般的にはソートの中で一番高速ですが、ある程度整列している状態であれば挿入ソートの方が高速なため、クイックソートである程度ソートしたあとに挿入ソートで整列する方法が採られることもあります。

コードは以下になります。

Sub insertsort(a_Ar())
    Dim iNow                    '// ループカウンタ（現要素用）
    Dim iBefore                 '// ループカウンタ（前要素用）
    Dim temp                    '// 一時格納領域
    Dim iArrayCount             '// 配列要素数
    
    '// 配列の要素数を取得
    iArrayCount = UBound(a_Ar)
    
    '// 配列
    For iNow = 1 To iArrayCount
        '// 配列の要素を一時格納
        temp = a_Ar(iNow)
        
        '// 前要素を取得
        iBefore = iNow - 1
        
        '// 前要素から先頭に向かってループ
        Do
            '// 配列要素外の場合
            If (iBefore < 0) Then
                Exit Do
            End If
            
            '// 入れ替える必要がない場合
            If (a_Ar(iBefore) <= temp) Then
                Exit Do
            End If
            
            '// 配列の前後を入れ替える
            a_Ar(iBefore + 1) = a_Ar(iBefore)
            
            '// 前要素を先頭側に移動する
            iBefore = iBefore - 1
        Loop
        
        '// 挿入個所に事前に取得した値を格納
        a_Ar(iBefore + 1) = temp
    Next
End Sub

Sub insertsort(a_Ar())

Dim iNow '// ループカウンタ（現要素用）

Dim iBefore '// ループカウンタ（前要素用）

Dim temp '// 一時格納領域

Dim iArrayCount '// 配列要素数

'// 配列の要素数を取得

iArrayCount = UBound(a_Ar)

'// 配列

For iNow = 1 To iArrayCount

'// 配列の要素を一時格納

temp = a_Ar(iNow)

'// 前要素を取得

iBefore = iNow - 1

'// 前要素から先頭に向かってループ

'// 配列要素外の場合

If (iBefore < 0) Then

Exit Do

End If

'// 入れ替える必要がない場合

If (a_Ar(iBefore) <= temp) Then

Exit Do

End If

'// 配列の前後を入れ替える

a_Ar(iBefore + 1) = a_Ar(iBefore)

'// 前要素を先頭側に移動する

iBefore = iBefore - 1

Loop

'// 挿入個所に事前に取得した値を格納

a_Ar(iBefore + 1) = temp

End Sub

利用方法はこのような感じになります。

Sub sorttest()
    Dim ar()
    
    ReDim ar(10)
    ar(0) = "9"
    ar(1) = "8"
    ar(2) = "7"
    ar(3) = "6"
    ar(4) = "5"
    ar(5) = "4"
    ar(6) = "3"
    ar(7) = "2"
    ar(8) = "1"
    ar(9) = "0"
    ar(10) = "a"
    
    Call insertsort(ar)
End Sub

Sub sorttest()

Dim ar()

ReDim ar(10)

ar(0) = "9"

ar(1) = "8"

ar(2) = "7"

ar(3) = "6"

ar(4) = "5"

ar(5) = "4"

ar(6) = "3"

ar(7) = "2"

ar(8) = "1"

ar(9) = "0"

ar(10) = "a"

Call insertsort(ar)

End Sub

ソート後は、以下の順になります。

    ar(0) = "0"
    ar(1) = "1"
    ar(2) = "2"
    ar(3) = "3"
    ar(4) = "4"
    ar(5) = "5"
    ar(6) = "6"
    ar(7) = "7"
    ar(8) = "8"
    ar(9) = "9"
    ar(10) = "a"

ar(0) = "0"

ar(1) = "1"

ar(2) = "2"

ar(3) = "3"

ar(4) = "4"

ar(5) = "5"

ar(6) = "6"

ar(7) = "7"

ar(8) = "8"

ar(9) = "9"

ar(10) = "a"

是非、活用してください。

関連記事