コレクション（Collection）の並べ替え（Sort）に対応するクラス

公開日：2019-07-20　最終更新日：2019-07-20

コレクション（Collection）の並べ替え（Sort）に対応するクラス

オブジェクトを扱う事が多くなってくるとコレクション（Collectionオブジェクト）を使う機会も増えてくると思います。
配列やディクショナリー（Dictionary）を使ったほうが良い場合も多くはありますが、
単純にオブジェクトを保管し、順序通り（FIFO）に処理するだけなら、とても扱いやすい場合もあります。

配列、ディクショナリー、コレクション、それぞれ一長一短はありますが、
コレクションはキーを扱いづらいので、これに関連して並べ替え（Sort）が難しい点があります。
そこで今回は、コレクションを並べ替えるクラスを作成しました。
実務的にあまり使用場面があるとは思えませんが、
VBAクラスとコレクション（Collection）の勉強素材として、考えてもらえれば良いと思います。

>コレクション（Collection）の並べ替え（Sort）に対応する方法

コレクションには通常はオブジェクトを入れる事になるため、並べ替えが普通にはできません。
かつ、
キー（Key）を指定しても、そのキーの取得ができない為、
コレクションに入れてしまった後では、並べ替えを実行するのはかなり大変になってしまいます。
そこで今回は、コレクションへの追加も含めてサポートする専用クラスを作ってみました。
処理概要

・ItemとKeyを保存する別々のコレクシヨンをつくる。
・コレクション追加時に、ItemとKeyをそれぞれのコレクションに追加する。
・ItemとKeyのコレクションを2次元配列に変換
・2次元配列をKeyで並べ替える
・ItemとKeyのコレクションを2次元配列をから再作成

このような順でコレクションの並べ替え（Sort）を行っています。
注意点としては、Key重複を認めている点になります。
コレクションのKeyを使ってしまうと重複できないが、独自Keyとして扱うので重複も可能。
Key重複させないのなら、そもそもDictionaryを使ったほうが良いでしょう。

コレクションの並べ替えに対応するクラスのVBAコード

クラスモジュール：clsCollection


  
    
      Option Explicit


      'コレクションはプロパティ経由でしか公開しない

      Private pItem As New Collection

      Private pKey As New Collection


      'Itemコレクションの受け渡し用プロパティ

      Public Property Set Item(argItem As Collection)

      　　Set pItem = argItem

      End Property

      Public Property Get Item() As Collection

      　　Set Item = pItem

      End Property


      'Keyコレクションの受け渡し用プロパティ

      Public Property Set Key(argKey As Collection)

      　　Set pKey = argKey

      End Property

      Public Property Get Key() As Collection

      　　Set Key = pKey

      End Property


      'コレクションの件数

      Public Property Get Count() As Long

      　　Count = pItem.Count

      End Property


      'クラス初期化

      Private Sub Class_Initialize()

      　　Set pItem = New Collection

      　　Set pKey = New Collection

      End Sub


      'コレクションへの追加メソッド

      Public Sub Add(ByVal Item As Variant, Key As Variant)

      　　pItem.Add Item

      　　pKey.Add Key

      End Sub


'コレクションのKeyで検索しIndexを返す：ほぼDebug用

Public Function Index(ByVal Key As Variant) As Long

　　Dim i As Long, v As Variant

　　i = 1

　　For Each v In pKey

　　　　'同一Keyの先頭を返す：cKeyのItemなので重複もある

　　　　If v = Key Then

　　　　　　Index = i

　　　　　　Exit Function

　　　　End If

　　　　i = i + 1

　　Next

　　'存在しない場合は全件ループするので少し時間がかかります

　　Index = -1

End Function


      'Itemを配列で返す：外部から利用

      Public Function Items() As Variant()

      　　Dim i As Long, v As Variant

      　　Dim myArray() As Variant

      　　ReDim myArray(1 To Me.Count)

      　　i = 1

      　　For Each v In pItem

      　　　　Set myArray(i) = v

      　　　　i = i + 1

      　　Next

      　　Items = myArray

      End Function


      'keyを配列で返す：外部から利用

      Public Function Keys() As Variant()

      　　Dim i As Long, v As Variant

      　　Dim myArray() As Variant

      　　ReDim myArray(1 To Me.Count)

      　　i = 1

      　　For Each v In pKey

      　　　　Set myArray(i) = v

      　　　　i = i + 1

      　　Next

      　　Keys = myArray

      End Function


      'コレクションをKeyで並べ替え

      Public Sub Sort()

      　　Dim tStart As Double '時間計測用

      　　

      　　'コレクションを2次元配列に変換

      　　tStart = Timer

      　　Dim myArray() As Variant

      　　Call Collection2Array(pItem, pKey, myArray)

      　　Debug.Print "Sort内：Collection→配列:"; Timer - tStart

      　　

      　　'元のコレクションを初期化

      　　Set pItem = New Collection

      　　Set pKey = New Collection

      　　

      　　'2次元配列をKeyでクイックソート

      　　tStart = Timer

      　　Call QuickSort(myArray, LBound(myArray), UBound(myArray), 2)

      　　Debug.Print "Sort内：配列クイックSort:"; Timer - tStart

      　　

      　　'2次元配列をコレクションに変換

      　　tStart = Timer

      　　Call Array2Collection(pItem, pKey, myArray)

      　　Debug.Print "Sort内：配列→Collection:"; Timer - tStart

      End Sub


      '*** 以下は外部からは使わないので非公開メソッド ***


      'コレクションを2次元配列に変換

      Public Sub Collection2Array(ByRef cItem As Collection, _

      　　　　　　　　　　　　　　 ByRef cKey As Collection, _

      　　　　　　　　　　　　　　 ByRef argArray() As Variant)

      　　Dim i As Long

      　　Dim v As Variant

      　　

      　　'配列を初期化

      　　ReDim argArray(1 To cItem.Count, 1 To 2)

      　　

      　　'Itemはオブジェクト限定

      　　i = 1

      　　For Each v In cItem

      　　　　Set argArray(i, 1) = v

      　　　　i = i + 1

      　　Next

      　　

      　　'Keyは文字列・数値等

      　　i = 1

      　　For Each v In cKey

      　　　　argArray(i, 2) = v

      　　　　i = i + 1

      　　Next

      End Sub


      '2次元配列をコレクションに変換：外部からは使わないので非公開

      Private Sub Array2Collection(ByRef cItem As Collection, _

      　　　　　　　　　　　　　　 ByRef cKey As Collection, _

      　　　　　　　　　　　　　　 ByRef argArray() As Variant)

      　　Dim i As Long

      　　For i = LBound(argArray, 1) To UBound(argArray, 1)

      　　　　cItem.Add argArray(i, 1)

      　　　　cKey.Add argArray(i, 2)

      　　Next

      End Sub


      '2次元配列をKeyでクイックソート：外部からは使わないので非公開

      Private Sub QuickSort(ByRef argAry() As Variant, _

      　　　　　　　　　　　ByVal lngMin As Long, _

      　　　　　　　　　　　ByVal lngMax As Long, _

      　　　　　　　　　　　ByVal keyPos As Long)

      　　Dim i As Long, j As Long, k As Long

      　　Dim vBase As Variant, 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)

      　　　　　　If k = keyPos Then

      　　　　　　　　'Keyはプリミティブ型として扱う

      　　　　　　　　vSwap = argAry(i, k)

      　　　　　　　　argAry(i, k) = argAry(j, k)

      　　　　　　　　argAry(j, k) = vSwap

      　　　　　　Else

      　　　　　　　　'Key以外はオブジェクトとして扱う

      　　　　　　　　Set vSwap = argAry(i, k)

      　　　　　　　　Set argAry(i, k) = argAry(j, k)

      　　　　　　　　Set argAry(j, k) = vSwap

      　　　　　　End If

      　　　　Next

      　　　　i = i + 1

      　　　　j = j - 1

      　　Loop

      　　If (lngMin < i - 1) Then

      　　　　Call QuickSort(argAry, lngMin, i - 1, keyPos)

      　　End If

      　　If (lngMax > j + 1) Then

      　　　　Call QuickSort(argAry, j + 1, lngMax, keyPos)

      　　End If

      End Sub

クラスの基本については以下を参照してください。
VBAのクラスとは（Class,Property,Get,Let,Set）

・オブジェクトとは・オブジェクト指向とは・カプセル化・オブジェクト指向とカプセル化とクラス・クラスの必要性と利点・一般的なクラスに関する説明・クラスの比喩的説明・クラスの使い方・クラスを体験してみる・クラスの使用例・クラス入門の最後に

クイックソートについては以下を参照してください。
2次元配列の並べ替え（バブルソート,クイックソート）

・検証方法・バブルソート・クイックソート・複数キーでの並べ替えについて・ワークシートを使って並べ替え・・・番外編

初回アップ時には、Indexメソッドは以下のように書いていました。


  
    
      'コレクションのKeyで検索しIndexを返す：ほぼDebug用

      Public Function Index(ByVal Key As Variant) As Long

      　　Dim i As Long

      　　For i = 1 To Me.Count

      　　　　'同一Keyの先頭を返す：cKeyのItemなので重複もある

      　　　　If pKey(i) = Key Then

      　　　　　　Index = i

      　　　　　　Exit Function

      　　　　End If

      　　Next

      　　'存在しない場合は全件ループするので遅い

      　　Index = -1

      End Function

これに対して、
「IndexだけCollectionの添え字アクセスの対策がされていないようです」
とのご指摘をTwitterでいただきました。

コレクションに対して、インデックス指定してアクセスすると、後ろの要素に行くにしたがってとても遅くなります。
これは、コレクションのメモリ構造がチェーンのように次々につながっている事に起因します。

VBAコメントにもあるようにDebug用なので、他とは違ってこのようにしたところもありますが、
やはり遅いものは遅いですし、学習教材として考えた時にも良くないので訂正しました。
ですが逆に言えば、コレクションの特性を考える良い材料とも言えますので、元々のVBAもここに残しておきます。

コレクションの並べ替えに対応するクラスの使い方

以下のサンプルでは、
シートのA列にランダムなデータを用意しています。
このA列のセルをオブジェクトとして、ValueをKeyとしてコレクションに入れ、
ValueであるKeyで並べ替えます。
以下では、100万件のデータの時のサンプルになります。

標準モジュール


  
    
      Sub CollectionTest()

　　Dim clsColl As New clsCollection

　　Dim tStart As Double '時間計測用

　　

　　'A列に入っているデータをコレクションに入れる

　　tStart = Timer

　　Dim i As Long

　　For i = 1 To 1000000

　　　　'引数：Rangeオブジェクト, Rangeの値

　　　　clsColl.Add Cells(i, 1), Right(Cells(i, 1).Value, 7)

　　Next

　　Debug.Print "コレクション作成:"; Timer - tStart

　　

　　'コレクションをKeyで並べ替え実行

　　tStart = Timer

　　Call clsColl.Sort

　　Debug.Print "コレクションSort:"; Timer - tStart

　　

　　'ソート後コレクションのItemをB列に出力

　　tStart = Timer

　　Columns(2).Clear

　　Dim myArray1() As Variant, myArray2() As Variant

　　myArray1 = clsColl.Items

　　ReDim myArray2(1 To UBound(myArray1), 1 To 1)

　　For i = 1 To UBound(myArray1)

　　　　myArray2(i, 1) = myArray1(i)

　　Next

　　Range("B1").Resize(UBound(myArray2)) = myArray2

　　Debug.Print "コレクション出力:"; Timer - tStart

　　

　　'上記以外のメソッドを使って最終確認

　　With clsColl

　　　　'元A1セルの先位置

　　　　Debug.Print "元A1セルの先位置:"; .Index(Right(Cells(1, 1).Value, 7))

　　　　'後B1セルの元位置

　　　　Debug.Print "後B1セルの元位置:"; .Item(1).Address

　　End With

　　

　　Set clsColl = Nothing

End Sub

実行後は、以下のようになります。

※ランダム数を元に作成したので、抜け番および重複があります。

コレクションの並べ替えに対応するクラスの実行時間

上掲のマクロVBAを実行するとイミディエイトウインドウに実行結果が出力されます。


  
    
      コレクション作成: 10.64453125

Sort内：Collection→配列: 0.4375

Sort内：配列クイックSort: 3.578125

Sort内：配列→Collection: 0.796875

コレクションSort: 5.609375

コレクション出力: 5.1875

元A1セルの先位置: 34397

後B1セルの元位置:$A$632639

※単位は秒

ソートに要する時間は、5.6秒位です。
どうしても、100万件のソートには時間がかかるようです。
100万件でこの速度なら実用としては十分なのではないでしょうか。
10万件であれば、以下の通りです。


  
    
      コレクション作成: 0.91015625

Sort内：Collection→配列: 0.03125

Sort内：配列クイックSort: 0.3203125

Sort内：配列→Collection: 0.046875

コレクションSort: 0.4765625

コレクション出力: 0.625

元A1セルの先位置: 3471

後B1セルの元位置:$A$26375

最後に

最初にも書きましたが、実用としての需要はかなり少ないだろうと思います。
そもそも並べ替えが必要であれば最初からコレクションに入れないでしょうし、
コレクションに入れてから並べ替えをしようとはあまり思わないでしょう。
という事ですので、
あくまでクラスとコレクションを扱う勉強素材として、自由に改変しながら使ってみてください。

VBAコードに関しては、学習用という事を前提に書いている部分も多くあります。
変数名等は、WEB掲載も考慮して短めにしていたり、
プロパティ名や引数名もコレクション規定の名称に合わせたりしています。
標準モジュールから見た時には、
元々のコレクションを扱っているような感じで独自クラスを扱えるようにという配慮でもあります。
こういうところも含めて、学習用としてVBAコードを読み解いてみてください。

同じテーマ「VBAクラス入門」の記事

VBAクラスの作り方：列名のプロパティを自動作成する
 VBAクラスの作り方：独自Rangeっぽいものを作ってみた
 クラスとイベントとマルチプロセス並列処理
 クラスとCallByNameとポリモーフィズム(多態性)
オートフィルターを退避回復するVBAクラス
 オートフィルター退避回復クラスを複数シート対応させるVBAクラス
コレクション（Collection）の並べ替え（Sort）に対応するクラス
VBAクラスのAttributeについて（既定メンバーとFor Each）
VBAクラスを使ったイベント作成（Event,RaiseEvent,WithEvents）
VBAで音楽再生するクラスを作成
 図形を方程式で動かすVBAクラス

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA応用編
VBAクラス入門
コレクション（Collection）の並べ替え（Sort）に対応するクラス

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA技術解説
コレクション（Collection）の並べ替え（Sort）に対応するクラス