【VBA】キューを実装する

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

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

このブログではこれまでにクラスモジュールを活用したコードをいくつか紹介してきたが、使いどころの紹介がメインでクラスモジュールそのものの使い方について一から学べるような構成は取っていなかった。今回は「クラスモジュール超入門」と題してクラスモジュールを初めて使う方やオブジェクト指向がいまひとつ分からないという方に向けて解説...

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

Excelのクラスモジュールを使ったプロパティ設定の書き方、サブルーチンの使い方などを、図解を交えてまとめました。標準モジュールの使い方に慣れてきて、もうちょっとステップアップしたい中級者向けです。

キューの構造
実装する機能
キューの実装
キューのテスト
Github

キューの構造

キューはデータ構造の一種です。
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

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