エクセルVBAでバブルソート

バブルソート

隣の数値を比較して

左が大きい場合は数値を入れ替え
左が大きくない場合は入れ替えしない

この処理を左から右へ行う

右端まで達したら、また左から繰り返す

繰り返す(ループさせる)回数は数値の数-1

だいたいこんな感じだと思う、大きい数値を右へ右へと移動させる感じ

例えば{3, 4, 1, 3, 2}を{1, 2, 3, 3, 4}に小さい順に並べ替えするとき

1回目のループ

3,4,1,3,2 3と4を比較する、左の3は右の4より大きくないので入れ替えない
3,4,1,3,2 4と2を比較する、左の4は右の2より大きいので入れ替える
3,1,4,3,2 入れ替えた
3,1,4,3,2 4と3を比較する、左の4は右の1より大きいので入れ替える
3,1,3,4,2 入れ替えた
3,1,3,4,2 4と2を比較する、左の4は右の2より大きいので入れ替える
3,1,3,2,4 入れ替えた、右端まで来たので次のループへ

これをまた左から繰り返していくと小さい順に並ぶことになる

繰り返す回数は並べ替えるものの個数-1

3,4,1,3,2と5つの場合は5-1=4回繰り返す

2回めは

3,1,3,2,4 入れ替える
1,3,3,2,4 入れ替えた
1,3,3,2,4 そのまま
1,3,3,2,4 入れ替える
1,3,2,3,4 入れ替えた
1,3,2,3,4 そのまま

3回めは

1,3,2,3,4
1,3,2,3,4
1,2,3,3,4
1,2,3,3,4
1,2,3,3,4

4回目

1,2,3,3,4
1,2,3,3,4
1,2,3,3,4
1,2,3,3,4

これで並べ替え完了

この手順をVBAで書いたのが

'バブルソート

'探索範囲不変更＆毎回入れ替え

Function testBubble1(v As Variant) As Variant
Dim i As Long, j As Long
Dim temp As Variant
    For i = 0 To UBound(v) - 1
        For j = 0 To UBound(v) - 1
           '左(j)＞右(j+1)なら数値を入れ替える
            If v(j) > v(j + 1) Then
               '入れ替え
                tmp = v(j)
                v(j) = v(j + 1)
                v(j + 1) = tmp
            End If
        Next
    Next
    testBubble1 = v
End Function

これを

Sub sortTestBubble()
v = Array(3, 4, 1, 3, 2)
v = testBubble1(v)
End Sub

こんなふうに呼び出すと

３，４，１，３，２が１，２，３，３，４になって返ってくる

並べ替えできている

1万件の並べ替えのタイムは18.90234秒

このままでもいいけど、もう少し効率良くできる

さっきの処理一覧

1回目が終わった時点(7番目)で必ず右端の数値は最大値になるので2回めには比較する必要がないから省くことができる

ってことは2回目は3,1,3,2,4のうち3,1,3,2だけ比較すればいい

同じように2回めが終わったときの1,3,2,3、これも右端が最大値なので3回目はこれを省いて1,3,2だけ比較すればいい

こんなふうに繰り返しごとに1個減らすことができる

1回目

3,4,1,3,2
3,4,1,3,2
3,1,4,3,2
3,1,4,3,2
3,1,3,4,2
3,1,3,4,2
3,1,3,2,4

2回め

3,1,3,2,4
1,3,3,2,4
1,3,3,2,4
1,3,3,2,4
1,3,2,3,4

3回めは

1,3,2,3,4
1,3,2,3,4
1,2,3,3,4

4回目

1,2,3,3,4

この方法をさっきのtestBubble1に取り入れたのがtestBubble2

↓

'探索範囲変更＆毎回入れ替え
Public Function testBubble2(v As Variant) As Variant
    Dim i As Long, j As Long
    Dim c As Long: c = 1
    Dim tmp As Variant
    For i = 0 To UBound(v) - 1
        For j = 0 To UBound(v) - c '比較範囲をループ回数分狭くする
           '左(j)＞右(j+1)なら数値を入れ替える
            If v(j) > v(j + 1) Then
               '入れ替え
                tmp = v(j)
                v(j) = v(j + 1)
                v(j + 1) = tmp
            End If
        Next
        c = c + 1 'ループ回数カウントUp
    Next
    testBubble2 = v
End Function

1万件の並べ替えのタイムは12.27734秒

約1.5倍速くなった

もう少し速くなるかも？

配列の中の値を入れ変えるときの処理は3手

tmp = v(j)’左の値を適当な変数に入れる

v(j) = v(j + 1)’右の値を左にコピー

v(j + 1) = tmp’適当な変数に入れておいた値を右にコピー

これを

左の値を適当な変数tmpに入れてこれを右と比較していく

tmp＜右なら左にtmpの値を戻してかわりに右の値をtmpに入れて次へ

tmp＞右なら右の値を左にコピーして次へ

つまり右の数値が小さいければ入れ替えは発生しないでコピーするだけなので手数は1手で済む

1回目のループだと

3,4,1,3,2 tmp=3<4=Trueなのでtmpを入れ替え
3,1,1,3,2 tmp=4<1=Falseなので1を左へコピー
3,1,3,3,2 tmp=4<3=Falseなので3を左へコピー
3,1,3,2,2 tmp=4<2=Falseなので2を左へコピー
3,1,3,2,4 最後はtmpを戻す

合計手数は入れ替え2回なのでこれで2x3=6とコピーが3回で合計9回かな、この場合だと全く変わらないかも

左側に大きい数値がない配列だと逆に遅くなるかも

でも一応書いてみたのがこれtestBubble3

'探索範囲変更＆必要なときだけ入れ替え
Public Function testBubble3(v As Variant) As Variant
    Dim i As Long, j As Long
    Dim c As Long: c = 1
    Dim tmp As Variant
    For i = 0 To UBound(v) - 1
        tmp = v(0) '比較する数値をtmpに入れる
        For j = 0 To UBound(v) - c
           'tmp＞右(j+1)なら左へ上書き
            If tmp > v(j + 1) Then
               '右の値を左へ上書き
                v(j) = v(j + 1)
            Else
               'tmpの値を配列に戻す
                v(j) = tmp
               'tmpに右(j+1)の数値を入れる
                tmp = v(j + 1)
            End If
        Next
        v(j) = tmp 'ループの最後はtmpの値を配列に戻す
        c = c + 1
    Next
    testBubble3 = v
End Function

1万件の並べ替えのタイムは

速くなった、何回か計測したけどだいたい10秒

タイム計測のコード

0から1万までのランダム整数値の1万件の配列を作成してタイム計測

Sub sortTestBubble2()
    Dim c As Long: c = 10000
    Dim v() As Variant
    ReDim v(c - 1)
    For i = 0 To c - 1
        v(i) = CInt(c * Rnd)
    Next
    Dim st As Single
    st = Timer
'  v = testBubble1(v)
'  v = testBubble2(v)
    v = testBubble3(v)
    MsgBox Timer - st & "秒"
End Sub