拡張コレクション（自動ソート機能）
'拡張コレクション（自動ソート機能）
'CollectionEx
Option Explicit
'内部コレクションクラス
Private innerCollection As Collection
'初期化
Private Sub Class_Initialize()
Set innerCollection = New Collection
End Sub
'要素を追加
Public Sub add(ByRef elm As Object, ByVal key As String)
'IDが順番通りになるようにインスタンスを追加する
Dim index As Integer
For index = 1 To innerCollection.Count
If elm.id < innerCollection.Item(index).id Then
Call innerCollection.add(elm, elm.id, index)
Exit For
End If
Next
'ループ内で追加されなかった場合はリストの終端に要素を追加する
If index > innerCollection.Count Then
Call innerCollection.add(elm, elm.id)
End If
End Sub
'全要素を削除
Public Sub Clear()
Set innerCollection = New Collection
End Sub
'要素数を返す
Public Function Count() As Long
Count = innerCollection.Count
End Function
'指定番号の要素を返す
Public Function Item(index As Integer) As UserClass
Item = innerCollection.Item(index)
End Function
'先頭の要素を返す(リストからは要素を削除)
Public Function popHead() As UserClass
If innerCollection.Count = 0 Then Exit Function
Set popHead = innerCollection.Item(1)
innerCollection.Remove (1)
End Function
'終端の要素を返す(リストからは要素を削除)
Public Function popTail() As UserClass
If innerCollection.Count = 0 Then Exit Function
Set popTail = innerCollection.Item(innerCollection.Count)
innerCollection.Remove (innerCollection.Count)
End Function
Userクラス
'UserClass
Option Explicit
'///// メンバ変数 /////
'ユーザーID
Private m_id As String
'ユーザー名
Private m_name As String
'年齢
Private m_age As Integer
'居住地
Private m_address As String
'///// プロパティプロシージャ /////
Property Get id() As String
id = m_id
End Property
Property Let id(ByVal id As String)
m_id = id
End Property
Property Get name() As String
name = m_name
End Property
Property Let name(ByVal name As String)
m_name = name
End Property
Property Get age() As Integer
age = m_age
End Property
Property Let age(ByVal age As Integer)
m_age = age
End Property
Property Get address() As String
address = m_address
End Property
Property Let address(ByVal address As String)
m_address = address
End Property
'ユーザーの属性をセットする
Public Sub setAttribute(ByVal id As String, ByVal name As String, ByVal age As Integer, ByVal address As String)
m_id = id
m_name = name
m_age = age
m_address = address
End Sub
呼び出し側（ActiveXボタンを貼り付けてイベントプロシージャを記述）
'拡張したコレクションの実装例
Option Explicit
Private Sub CommandButton1_Click()
'ユーザークラスの宣言
Dim u1 As New UserClass
Dim u2 As New UserClass
Dim u3 As New UserClass
Dim u4 As New UserClass
Dim u5 As New UserClass
'ユーザーリストの宣言
Dim userList As New CollectionEx
'ユーザーに属性をセット
Call u1.setAttribute("1090", "Taro", "20", "Tokyo")
Call u2.setAttribute("1050", "Hanako", "28", "Osaka")
Call u3.setAttribute("1010", "Ichiro", "18", "Fukuoka")
Call u4.setAttribute("1080", "Yoshiko", "25", "Nagoya")
Call u5.setAttribute("1020", "Kensuke", "15", "Sapporo")
'ユーザーのIDをKEYとしてユーザーリストに追加
Call userList.add(u1, u1.id)
Call userList.add(u2, u2.id)
Call userList.add(u3, u3.id)
Call userList.add(u4, u4.id)
Call userList.add(u5, u5.id)
'要素数
Debug.Print "要素数:" & userList.Count
'先頭から要素を取得し名前を表示する（ID順で表示される）
Debug.Print userList.popHead.name
Debug.Print userList.popHead.name
Debug.Print userList.popHead.name
Debug.Print userList.popHead.name
Debug.Print userList.popHead.name
'要素数
Debug.Print "要素数:" & userList.Count
End Sub
