【VBA】キューを実装する

VBAにデータ構造のキューがないのでクラスモジュールを使用してキューを実装してみます。

クラスモジュールの使用方法については下記サイト様の情報を参照させていただきました。
ありがとうございます。

VBA クラスモジュール超入門 - t-hom’s diary

thom.hateblo.jp

ExcelVBAのクラスモジュールって何？という人向けの使い方まとめ *Ateitexe

ateitexe.com

キューの構造
#

キューはデータ構造の一種です。
FIFO(First In First Out)といわれる最初に入れたデータが、最初に取り出される構造になっています。キューにデータを入れる操作をenqueue(エンキュー)、キューからデータを取り出す操作をdequeue(デキュー)といいます。

実装する機能
#

今回はクラスモジュールを使用して、下記の機能を実装してみます。

キューの末尾にデータを追加するenqueue(エンキュー)
キューに存在する先頭のデータを取り出すdequeue(デキュー)
キューに存在するデータ数をカウントするcount(カウント)

キューの実装
#

クラスモジュールを追加します。

追加されたクラスモジュール名をClass1からQueueに変更します。

Queueクラスのコードは以下になります。
Collection型を利用してキューを実装しています。

Option Explicit

Private c As Collection       'キューのデータ本体
Private dataSizeIndex As Long '最後尾のデータ位置
Private headerIndex As Long   '先頭のデータ位置

Private Sub Class_Initialize()
  'コンストラクタ
  
  Set c = New Collection
  dataSizeIndex = 0
  headerIndex = 0
  
End Sub
Public Sub enqueue(v As Variant)
  'キューの末尾にデータを追加する
  
  c.Add v, CStr(dataSizeIndex)       'collectionのkeyはstring型しか設定できない
  dataSizeIndex = dataSizeIndex + 1
  
End Sub
Public Function dequeue() As Variant
  'キューの先頭のデータを取り出す
  
  If c.count = 0 Then
    'キューにデータが存在しないときは、エラー番号1000をRaiseする
    Err.Raise 1000, "Queue", "キューにデータが存在しません"
  End If
  
  Dim vType As Long
  vType = VarType(c.Item(CStr(headerIndex)))
  
  Select Case vType
    'オブジェクト、データアクセスオブジェクト、ユーザー定義型は
    'Set構文を利用する
    Case vbObject
      Set dequeue = c.Item(CStr(headerIndex))
    Case vbDataObject
      Set dequeue = c.Item(CStr(headerIndex))
    Case vbUserDefinedType
      Set dequeue = c.Item(CStr(headerIndex))
    Case Else
      dequeue = c.Item(CStr(headerIndex))
  End Select
  
  Call c.Remove(CStr(headerIndex))
  headerIndex = headerIndex + 1
  
End Function
Public Function count() As Long
  'キューのデータ数をカウントする
  
  count = c.count

End Function
Private Sub Class_Terminate()
  'デストラクタ
  
  Set c = Nothing
  
End Sub

キューのテスト
#

標準モジュールを追加します。

追加した標準モジュールにQueueをテストするコードを貼り付けます。
Queueクラスをテストするコードは以下になります。

Option Explicit
Sub test_Queue()

On Error GoTo ErrorLabel
  
  Dim q As Queue
  Set q = New Queue 'Queueクラスをインスタンス化
  
  q.enqueue 1       '1をキューに追加する
  q.enqueue 2       '2をキューに追加する
  q.enqueue 3       '3をキューに追加する
  MsgBox q.dequeue  '1をキューから取り出す
  MsgBox q.dequeue  '2をキューから取り出す
  MsgBox q.dequeue  '3をキューから取り出す
  MsgBox q.dequeue  'エラー番号1000がraiseされる

ErrorLabel:
  If Err.Number = 1000 Then
    MsgBox Err.Description, vbCritical, "エラー発生"
  Else
    MsgBox Err.Description, vbCritical, "エラー発生"
  End If
  
End Sub