VBAの配列をバブルソートで並べ替え｜ Excel作業をVBAで効率化

VBAでのバブルソート

VBAでは以下のように括弧を付けることで配列を使うことができます。

Dim sArray()

1	Dim sArray()

このときに、格納済みの配列の並び順を昇順や降順に変えたいことがあります。しかし残念ながらVBAの標準機能では配列の並び順を変えることはできません。解決するにはいくつか方法ありますが、ここではバブルソートの関数を作成する方法を紹介します。

なお、他のソートについては以下をご参照ください。
「VBAの配列をクイックソートで並べ替え」
「VBAの配列を挿入ソートで並べ替え」
「VBAの配列を.NETのArrayListのSortで並べ替え」
「VBAの配列を逆順に並べ替え」

バブルソートとは、隣同士の値の大小を比較し、必要に応じて入れ替えていき、それを先頭から最後まで繰り返す方法です。先頭から最後までの並べ替えを配列の要素数繰り返すことで並べ替えが完了します。

利点として仕組みが単純なため実装しやすい点がありますが、欠点としてソート処理としては高速ではない点があります。クイックソートなどのもっと高速なアルゴリズムはありますが、バブルソートと比べるとどうしても複雑な仕組みになるため、そこまで高速性を求めない場合であれば十分に利用できます。

ちなみに、遅いとは言ってもコンピュータの中での話ですので、「100万件のデータを繰り返し並べ替える」とかの性能要求がなく、「100件程度の並べ替え」ぐらいであれば１秒も変わらないためバブルソートで十分です。

バブルソートの例

以下は昇順（小さい順）のバブルソートの考え方の例です。黄色部分が値の入れ替えを行っている箇所で、緑部分は入れ替えていない箇所です。

０回目：4 – 3 – 2 – 1（並べ替え前）
１回目：3 – 2 – 1 – 4
（4と3を比較し入れ替え（3 – 4 – 2 – 1）、4と2を比較し入れ替え（3 – 2 – 4 – 1）、4と1を比較し入れ替え（3 – 2 – 1 – 4））
２回目：2 – 1 – 3 – 4
（3と2を比較し入れ替え（2 – 3 – 1 – 4）、3と1を比較し入れ替え（2 – 1 – 3 – 4）、3と4を比較し入れ替えなし（2 – 1 – 3 – 4））
３回目：1 – 2 – 3 – 4（この時点で並べ替え完了）
（2と1を比較し入れ替え（1 – 2 – 3 – 4）、2と3を比較し入れ替えなし（1 – 2 – 3 – 4）、3と4を比較し入れ替えなし（1 – 2 – 3 – 4））
４回目：配列要素数の4に達したため、ここでは並べ替えを行わずバブルソートを終了する。

このように、単純な並べ替えを行った場合、１回目の並べ替えで終端（右端）には必ず一番大きな値（上の例では4）がきます。２回目には２番目に大きな値（上の例では3）が終端の直前にきます。

これはバブルソートの特性のため、言い換えれば、１回目に確定した一番大きな値は２回目以降は並べ替えをする必要がなくなるため、その部分は処理を省略することで高速化を望めます。

上の例はわかりやすく書いていますが、下の実装では不要になった並べ替え部分は処理を行わないように高速化を考慮しています。

バブルソートのコード

以下の関数は、バブルソートの仕組みの通り、隣り合う要素の大小を比較して、降順（小さい順）に並べなおします。

要素の先頭から最後までの入れ替えを１回行うと一番最後の要素にそのループでの最大値が設定されます。よって、次のループでは一番最後の要素まで比較せずに済むため、その分を減らしています。（iArCnt2 = iArCnt2 – 1の部分です）

Sub bubbleSort(a_Ar)
    Dim i, ii               '// ループカウンタ
    Dim iArCnt              '// 配列の要素数
    Dim iArCnt2             '// 配列の要素数
    Dim v                   '// 一時保存用
    
    '// 配列の要素数を取得
    iArCnt = UBound(a_Ar)
    iArCnt2 = iArCnt
    
    i = 0
    
    '// 配列要素数ループ（全要素）
    Do While (i < iArCnt)
        ii = 0
        '// 配列要素数ループ（大小比較）
        Do While (ii < iArCnt2)
            '// 現ループの内容が次ループ時の内容より大きい場合
            If (a_Ar(ii) > a_Ar(ii + 1)) Then
                '// 小さい順に並べなおす
                v = a_Ar(ii)                '// 現ループの大きい値を一時保存
                a_Ar(ii) = a_Ar(ii + 1)     '// 次ループの小さい値を現ループ値にセット
                a_Ar(ii + 1) = v            '// 次ループに現ループの値をセット
            End If
            
            ii = ii + 1
        Loop
        
        '// 最大値が確定したため未確定部分のみループするようにカウンタを減らす
        iArCnt2 = iArCnt2 - 1
        
        i = i + 1
    Loop
End Sub

Sub bubbleSort(a_Ar)

Dim i, ii '// ループカウンタ

Dim iArCnt '// 配列の要素数

Dim iArCnt2 '// 配列の要素数

Dim v '// 一時保存用

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

iArCnt = UBound(a_Ar)

iArCnt2 = iArCnt

i = 0

'// 配列要素数ループ（全要素）

Do While (i < iArCnt)

ii = 0

'// 配列要素数ループ（大小比較）

Do While (ii < iArCnt2)

'// 現ループの内容が次ループ時の内容より大きい場合

If (a_Ar(ii) > a_Ar(ii + 1)) Then

'// 小さい順に並べなおす

v = a_Ar(ii) '// 現ループの大きい値を一時保存

a_Ar(ii) = a_Ar(ii + 1) '// 次ループの小さい値を現ループ値にセット

a_Ar(ii + 1) = v '// 次ループに現ループの値をセット

End If

ii = ii + 1

Loop

'// 最大値が確定したため未確定部分のみループするようにカウンタを減らす

iArCnt2 = iArCnt2 - 1

i = i + 1

Loop

End Sub

以下は降順用のバブルソート関数です。関数名のDescは「descending」の略です。大小比較の部分の > を < に変更し、大小の入れ替え処理を反対にしているだけです。

Sub bubbleSortDesc(a_Ar)
    Dim i, ii               '// ループカウンタ
    Dim iArCnt              '// 配列の要素数
    Dim iArCnt2             '// 配列の要素数
    Dim v                   '// 一時保存用
    
    '// 配列の要素数を取得
    iArCnt = UBound(a_Ar)
    iArCnt2 = iArCnt
    
    i = 0
    
    '// 配列要素数ループ（全要素）
    Do While (i < iArCnt)
        ii = 0
        '// 配列要素数ループ（大小比較）
        Do While (ii < iArCnt2)
            '// 現ループの内容が次ループ時の内容より小さい場合
            If (a_Ar(ii) < a_Ar(ii + 1)) Then
                '// 大きい順に並べなおす
                v = a_Ar(ii)                '// 現ループの小さい値を一時保存
                a_Ar(ii) = a_Ar(ii + 1)     '// 次ループの大きい値を現ループ値にセット
                a_Ar(ii + 1) = v            '// 次ループに現ループの値をセット
            End If
            
            ii = ii + 1
        Loop
        
        '// 最小値が確定したため未確定部分のみループするようにカウンタを減らす
        iArCnt2 = iArCnt2 - 1
        
        i = i + 1
    Loop
End Sub

Sub bubbleSortDesc(a_Ar)

Dim i, ii '// ループカウンタ

Dim iArCnt '// 配列の要素数

Dim iArCnt2 '// 配列の要素数

Dim v '// 一時保存用

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

iArCnt = UBound(a_Ar)

iArCnt2 = iArCnt

i = 0

'// 配列要素数ループ（全要素）

Do While (i < iArCnt)

ii = 0

'// 配列要素数ループ（大小比較）

Do While (ii < iArCnt2)

'// 現ループの内容が次ループ時の内容より小さい場合

If (a_Ar(ii) < a_Ar(ii + 1)) Then

'// 大きい順に並べなおす

v = a_Ar(ii) '// 現ループの小さい値を一時保存

a_Ar(ii) = a_Ar(ii + 1) '// 次ループの大きい値を現ループ値にセット

a_Ar(ii + 1) = v '// 次ループに現ループの値をセット

End If

ii = ii + 1

Loop

'// 最小値が確定したため未確定部分のみループするようにカウンタを減らす

iArCnt2 = iArCnt2 - 1

i = i + 1

Loop

End Sub

使い方

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

要素数を11の配列のarを用意し、各要素に文字列をセットします。そしてバブルソート関数を実行します。コメントアウトしているのは降順用の関数です。

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 bubbleSort(ar)
'    Call bubbleSortDesc(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 bubbleSort(ar)

' Call bubbleSortDesc(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"

VBAでのバブルソート

バブルソートの例

バブルソートのコード

使い方

関連記事