2次元配列の並べ替え(バブルソート,クイックソート)
配列(2次元)の並べ替え方法について、バブルソートとクイックソートのサンプルになります。
2次元配列の並べ替えと言えば、まさにワークシートの並べ替え機能になります。
本来は、ワークシートにデータを書き出して、ワークシートの並べ替え機能を使えば良いのですが、
しかし、どうしても、配列をワークシートに処理途中で書き出すと言うのは面倒なものです。
そこで、2次元配列を並べ替える必要が出てきます。
ソートアルゴリズムについては、詳細に解説しているサイトをご覧ください。
1次元配列の並べ替え(バブルソート,クイックソート)
キー位置(インデックス)を指定できるようにしています。
検証方法
これを(昇順に)並べ替えて、Sheet2 に出力しています。
Sub ソート検証()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim myAry1()
Dim i As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
myAry1 = ws1.Range("A1:B10000").Value
'2次元配列ソート
Dim start As Double: start = Timer
'Call バブルソート(myAry1, 1)
'Call クイックソート(myAry1, LBound(myAry1), UBound(myAry1), 1)
Debug.Print Timer - start
ws2.Cells.Clear
ws2.Range("A1:B10000").Value = myAry1
End Sub
Call バブルソート(myAry2, 1)
Call クイックソート(myAry2, LBound(myAry2), UBound(myAry2), 1)
引数の最後の,1がキー位置の指定になります。
複数回実行し、所要時間の平均時間の概数を記載しています。
時間はデータとPC環境にかなり依存しますので、あくまで目安になります。
バブルソート
バブルは「泡」のことで、並べ替えの過程でデータが下から上(上から下)へ移動する感じが、泡が浮かんでいく様に見えることからこの名前が付いているそうです。
Sub バブルソート(ByRef argAry() As Variant, ByVal keyPos As Long)
Dim vSwap
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = LBound(argAry, 1) To UBound(argAry, 1)
For j = LBound(argAry) To UBound(argAry) - 1
If argAry(j, keyPos) > argAry(j + 1, keyPos) Then
For k = LBound(argAry, 2) To UBound(argAry, 2)
vSwap = argAry(j, k)
argAry(j, k) = argAry(j + 1, k)
argAry(j + 1, k) = vSwap
Next
End If
Next j
Next i
End Sub
外側のFor~Nextの1回目が終わった時点で、配列の最後尾に最大値が来ます。
以下、2回目のループで配列の最後から2番目に2番目に大きいデータが来ます。
これの繰り返しになっています。
これを
If argAry(j, keyPos) < argAry(j + 1, keyPos) Then
とすれば、降順の並べ替えになります。
KeyPosが、並べ替えのキー位置(インデックス)になります。
データ件数が、少なければ単純で良いでしょう。
では、その処理時間を見てみます。
1万件で5秒以上・・・ちょっと使うにはギリギリですね。
それでも数千件以内なら、実用として問題ないと思います。
クイックソート
それがクイックソートになります。
クイックソートは一般的にとても高速だといわれてはいますが、
アルゴリズムとしてはいろいろな亜種があるらしいです。
ここでは、ごく一般的な方法を採用しています。
アルゴリズムの詳細は説明が長くなってしまいますし、上手に解説できませんので、
専門に解説しているページを参照して下さい。
Sub クイックソート(ByRef argAry() As Variant, _
ByVal lngMin As Long, _
ByVal lngMax As Long, _
ByVal keyPos As Long)
Dim i As Long
Dim j As Long
Dim k As Long
Dim vBase As Variant
Dim vSwap As Variant
vBase = argAry(Int((lngMin + lngMax) / 2), keyPos)
i = lngMin
j = lngMax
Do
Do While argAry(i, keyPos) < vBase
i = i + 1
Loop
Do While argAry(j, keyPos) > vBase
j = j - 1
Loop
If i >= j Then Exit Do
For k = LBound(argAry, 2) To UBound(argAry, 2)
vSwap = argAry(i, k)
argAry(i, k) = argAry(j, k)
argAry(j, k) = vSwap
Next
i = i + 1
j = j - 1
Loop
If (lngMin < i - 1) Then
Call クイックソート(argAry, lngMin, i - 1, keyPos)
End If
If (lngMax > j + 1) Then
Call クイックソート(argAry, j + 1, lngMax, keyPos)
End If
End Sub
このアルゴリズムをすっきり理解するのは大変ですね。
基準値を決め、大きい値のグループと小さい値のグループに分けることを繰り返します。
これを再帰プロージャーで、範囲を狭めながら繰り返しています。
これにより並べ替えを実現しています。
では、その処理時間を見てみます。
10万件で0.186秒
やはり断然はやいですね。
それ以上になるなら、やはりクイックソートを検討したほうが良いでしょう。
ユーザー定義型(構造体)の1次元配列とした方が良いのではないかと思います。
もちろんデータ内容にもよりますので、構造体にするのが大変な場合は別です。
ですが、大抵のデータ構造は、構造体を使う事でデータ構造を明示でき、
かつ、このような並べ替えにおいても、1次元配列として扱えるようになります。
構造体については、第110回.ユーザー定義型(構造体)Type
複数キーでの並べ替えについて
キーをつなげて、1つのキーとして扱います。
この時注意するのは、桁数です。
Key1 > Key2
で、数値の場合なら、
Format(Key1, "00000") & Format(Key1, "00000")
このように桁数を一致させて結合します。
もちろん、必要な最大桁数を指定します。
文字列なら、桁数が揃うように、後ろに半角スペースを入れます。
Key1 & Space(30 - Len(Key1)) & Key2 & Space(30 - Len(Key2))
こんな感じです。
これをソートキーとすることで複数キーの並べ替えが可能です。
ワークシートを使って並べ替え・・・番外編
Excel.Applicationのインスタンツを作成し、非表示Excel内で並べ替えを行います。
Sub SheetSort(ByRef argAry() As Variant, ByVal keyPos As Long)
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim xlApp As New Excel.Application
Set wb = xlApp.Workbooks.Add
Set ws = wb.ActiveSheet
With ws
Set rng = .Range(.Cells(LBound(argAry, 1), LBound(argAry, 2)), .Cells(UBound(argAry, 1), UBound(argAry, 2)))
rng.Value = argAry
rng.Sort Key1:=.Cells(1, keyPos), Order1:=xlAscending, Header:=xlNo
argAry = rng.Value
End With
wb.Close SaveChanges:=False
Set xlApp = Nothing
End Sub
上記は、LBoundが1であることを前提にしています。
LBoundが0の場合は、1を足し引きする部分の追加が必要になります。
では、使い方です。
Sub test3()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim myAry1()
Dim i As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
myAry1 = ws1.Range("A1:B10000").Value
'シートでソート
Dim start As Double: start = Timer
Call SheetSort(myAry1, 2)
Debug.Print Timer - start
ws2.Cells.Clear
ws2.Range("A1:C10000") = myAry1
End Sub
1万件で約1.398秒
10万件で6.13秒
Excelインスタンスを生成し、ブックの追加をしている事を考えれば、
予想以上に速いですね。
このくらいの件数までなら問題ないのではないでしょうか。
シート利用の場合は、並べ替え以外の時間がほとんどになっています。
ワークシートの並べ替えは非常に高速に動作しています。
従って、作業中のワークシートで並べ替えが可能ならば、それが最も良いと言う事になります。
少なくとも、配列を作成前がシートであったりソート後にシートに出力するのであれば、
シートで並べ替えしたほうが間違いなく良いでしょう。
同じテーマ「マクロVBAサンプル集」の記事
1次元配列の並べ替え(バブルソート,挿入ソート,クイックソート)
2次元配列の並べ替え(バブルソート,クイックソート)
Dir関数で全サブフォルダの全ファイルを取得
順列の全組み合わせ作成と応用方法
スピルに対応したXSPLITユーザー定義関数(文字区切り)
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.条件分岐(Select Case)|VBA入門
9.メッセージボックス(MsgBox関数)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- 2次元配列の並べ替え(バブルソート,クイックソート)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。