ExcelマクロVBAサンプル集
2次元配列の並べ替え(バブルソート,クイックソート)

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2019-07-21

2次元配列の並べ替え(バブルソート,クイックソート)


配列(2次元)の並べ替え方法について、バブルソートとクイックソートのサンプルになります。
2次元配列の並べ替えと言えば、まさにワークシートの並べ替え機能になります。
本来は、ワークシートにデータを書き出して、ワークシートの並べ替え機能を使えば良いのですが、
しかし、どうしても、配列をワークシートに処理途中で書き出すと言うのは面倒なものです。
そこで、2次元配列を並べ替える必要が出てきます。
以下では、
Sheet1A1~B10000にランダムなデータを入れました。
これを(昇順に)並べ替えて、Sheet2 に出力しています。
1次元配列の並べ替えについては、以下を参照して下さい。
1次元配列の並べ替え(バブルソート,クイックソート)

配列(1次元)の並べ替え方法について、バブルソートとクイックソートのサンプルになります。元来エクセルには、ワークシートの並べ替え機能があります。ワークシートにデータを書き出して、ワークシートの並べ替え機能を使えるのですが、どうしても、配列をワークシートに途中で書き出すと言うのは面倒なものです。
VBAコードはほぼ1次元配列と同様になりますが、
キー位置(インデックス)を指定できるようにしています。

バブルソート

ソートのアルゴリズムの中で、簡単で理解しやすいのは、バブルソートでしょう 。
バブルは「泡」のことで、並べ替えの過程でデータが下から上(上から下)へ移動する感じが、泡が浮かんでいく様に見えることからこの名前が付いているそうです。



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
これを
If argAry(j, keyPos) < argAry(j + 1, keyPos) Then
とすれば、降順の並べ替えになります。
KeyPosが、並べ替えのキー位置(インデックス)になります。

非常に単純ですが、処理時間がかかる事が難点です。
データ件数が、少なければ単純で良いでしょう。
では、実際の使い方と、その処理時間を見てみます。

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 = UBound(argAry) To LBound(argAry) Step -1
    For j = LBound(argAry) To i - 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

私の環境で 約6.8秒かかりました。
1万件で6.8秒・・・ちょっと使うにはギリギリですね。
Call バブルソート(myAry1, 1)
この第二引数の数値がキー位置のインデックスになっています。

クイックソート

バブルソートよりもっと効率の良いソートアルゴリズムはないのか・・・
それがクイックソートになります。
クイックソートは一般的に最も高速だといわれてはいますが、
アルゴリズムとしてはいろいろな亜種があるらしいです。
ここでは、ごく一般的な方法を採用しています。
アルゴリズムの詳細は説明が長くなってしまいますので、専門に解説しているページを参照して下さい。



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

このアルゴリズムをすっきり理解するのは大変ですね。
検索時の二分探索と同じような考え方と言えば良いでしょうか。
配列の中央値との大小比較を行い、取り替える。
これを再帰プロージャーで、範囲を狭めながら繰り返しています。
これにより並べ替えを実現しています。
では、実際の使い方と、その処理時間を見てみます。

Sub test2()
  Debug.Print Timer
  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次元クイックソート
  Call クイックソート(myAry1, LBound(myAry1), UBound(myAry1), 1)
  ws2.Cells.Clear
  ws2.Range("A1:B10000").Value = myAry1
  Debug.Print Timer
End Sub

私の環境で 約0.04秒です。
やはり断然はやいですね。

数百件程度の配列なら、バブルソートでもよいですが、
それ以上になるなら、やはりクイックソートが好ましいでしょう。
今回は2次元配列として紹介しましたが、
ユーザー定義型(構造体)の1次元配列とした方が良いのではないかと思います。
もちろんデータ内容にもよりますので、構造体にするのが大変な場合は別です。
ですが、大抵のデータ構造は、構造体を使う事でデータ構造を明示でき、
かつ、このような並べ替えにおいても、1次元配列として扱えるようになります。
構造体については、第110回.ユーザー定義型(構造体)Type

複数キーでの並べ替えについて

最も簡単な方法が、複数キーを1つに繋げたキーを作成する方法になります。
キーをつなげて、1つのキーとして扱います。
この時注意するのは、桁数です。
Key1 > Key2
で、数値の場合なら、
Format(Key1, "00000") & Format(Key1, "00000")
このように桁数を一致させて結合します。
もちろん、必要な最大桁数を指定します。
文字列なら、桁数が揃うように、後ろに半角スペースを入れます。
Key1 & Space(30 - Len(Key1)) & Key2 & Space(30 - Len(Key2))
こんな感じです。
これをソートキーとすることで複数キーの並べ替えが可能です。

ワークシートを使って並べ替え・・・番外編

最期に、ワークシートを使って2次元配列を並べ替えするプロシージャーを紹介します。
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()
  Debug.Print Timer
  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:C10000").Value
  'シートでソート
  Call SheetSort(myAry1, 2)
  ws2.Cells.Clear
  ws2.Range("A1:C10000") = myAry1
  Debug.Print Timer
End Sub

私の環境で 約0.72秒です。
Excelインスタンスを生成し、ブックの追加をしている事を考えれば、
予想以上に速いですね。
つまり、ワークシートの並べ替えが非常に高速である事の証になります。
従って、作業中のワークシートで並べ替えが可能ならば、それが最も良いと言う事になります。



同じテーマ「マクロVBAサンプル集」の記事

1次元配列の並べ替え(バブルソート,クイックソート)
2次元配列の並べ替え(バブルソート,クイックソート)
Dir関数で全サブフォルダの全ファイルを取得
順列の全組み合わせ作成と応用方法


新着記事NEW ・・・新着記事一覧を見る

Byte配列と文字コード関数について|VBA技術解説(8月20日)
PowerQueryの強力な機能をVBAから利用する方法|VBA技術解説(8月4日)
練習問題31(セル結合を解除して値を埋める)|VBA練習問題(7月30日)
練習問題30(マトリックス→リスト形式)|VBA練習問題(7月25日)
Applicationを省略できるApplicationのメソッド・プロパティ一覧|VBA技術解説(7月22日)
コレクション(Collection)の並べ替え(Sort)に対応するクラス|VBA技術解説(7月20日)
CSVの読み込み方法(ジャグ配列)|VBAサンプル集(7月15日)
その他のExcel機能(グループ化、重複の削除、オートフィル等)|VBA入門(7月14日)
オートフィルタ退避回復クラスを複数シート対応させるVBAクラス|VBA技術解説(7月6日)
オートフィルタを退避回復するVBAクラス|VBA技術解説(7月6日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.変数とデータ型(Dim)|ExcelマクロVBA入門
6.繰り返し処理(For Next)|ExcelマクロVBA入門
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.ひらがな⇔カタカナの変換|エクセル基本操作
10.空白セルを正しく判定する方法(IsEmpty,IsError,HasFormula)|VBA技術解説



  • >
  • >
  • >
  • 2次元配列の並べ替え(バブルソート,クイックソート)

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。




    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
    本文下部へ