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

ExcelマクロVBAの問題点と解決策、エクセルVBAの技術的解説
最終更新日: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)
VBAを覚えて、いろいろ作りながらネットで調べたりしていると、クラスとかオブジェクト指向といった言葉に出くわします。VBEの「挿入」の一番下にある「クラスモジュール」は気になっていたかもしれません。このクラスモジュールを使ってクラスを作ります。

クイックソートについては以下を参照してください。
2次元配列の並べ替え(バブルソート,クイックソート)
配列(2次元)の並べ替え方法について、バブルソートとクイックソートのサンプルになります。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万件のデータの時のサンプルになります。

マクロ VBA クラス コレクション

標準モジュール



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 クラス コレクション
※ランダム数を元に作成したので、抜け番および重複があります。

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

上掲のマクロ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クラスの作り方:列名のプロパティを自動作成する
VBAクラスの作り方:独自Rangeっぽいものを作ってみた
クラスとイベントとマルチプロセス並列処理
クラスとCallByNameとポリモーフィズム(多態性)
オートフィルタを退避回復するVBAクラス
オートフィルタ退避回復クラスを複数シート対応させるVBAクラス
コレクション(Collection)の並べ替え(Sort)に対応するクラス
VBAクラスのAttributeについて(既定メンバーとFor Each)
VBAクラスを使ったイベント作成(Event,RaiseEvent,WithEvents)


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

SQL関数と演算子|SQL入門(12月1日)
データの取得:集約集計、並べ替え(DISTINKT,GROUP BY,ORDER BY)|SQL入門(11月30日)
データの取得:条件指定(SELECT,WHERE)|SQL入門(11月29日)
データの挿入:バルクインサート|SQL入門(11月28日)
データの挿入(INSERT)と全削除|SQL入門(11月26日)
テーブル名変更と列追加(ALTER TABLE)とテーブル自動作成|SQL入門(11月25日)
テーブルの作成/削除(CREATE TABLE,DROP TABLE)|SQL入門(11月24日)
データベースに接続/切断|SQL入門(11月23日)
SQLiteのインストール|SQL入門(11月22日)
SQL入門:VBAでデータベースを使う|エクセルの神髄(11月22日)


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

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



  • >
  • >
  • >
  • コレクション(Collection)の並べ替え(Sort)に対応するクラス

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


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



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