【VBA】キューを実装する

概要

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

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

VBA クラスモジュール 超 入門
ExcelVBAのクラスモジュールって何?という人向けの使い方まとめ

キューの構造

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

実装する機能

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

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

キューの実装

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

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

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

 1Option Explicit
 2
 3Private c As Collection       'キューのデータ本体
 4Private dataSizeIndex As Long '最後尾のデータ位置
 5Private headerIndex As Long   '先頭のデータ位置
 6
 7Private Sub Class_Initialize()
 8  'コンストラクタ
 9  
10  Set c = New Collection
11  dataSizeIndex = 0
12  headerIndex = 0
13  
14End Sub
15Public Sub enqueue(v As Variant)
16  'キューの末尾にデータを追加する
17  
18  c.Add v, CStr(dataSizeIndex)       'collectionのkeyはstring型しか設定できない
19  dataSizeIndex = dataSizeIndex + 1
20  
21End Sub
22Public Function dequeue() As Variant
23  'キューの先頭のデータを取り出す
24  
25  If c.count = 0 Then
26    'キューにデータが存在しないときは、エラー番号1000をRaiseする
27    Err.Raise 1000, "Queue", "キューにデータが存在しません"
28  End If
29  
30  Dim vType As Long
31  vType = VarType(c.Item(CStr(headerIndex)))
32  
33  Select Case vType
34    'オブジェクト、データアクセスオブジェクト、ユーザー定義型は
35    'Set構文を利用する
36    Case vbObject
37      Set dequeue = c.Item(CStr(headerIndex))
38    Case vbDataObject
39      Set dequeue = c.Item(CStr(headerIndex))
40    Case vbUserDefinedType
41      Set dequeue = c.Item(CStr(headerIndex))
42    Case Else
43      dequeue = c.Item(CStr(headerIndex))
44  End Select
45  
46  Call c.Remove(CStr(headerIndex))
47  headerIndex = headerIndex + 1
48  
49End Function
50Public Function count() As Long
51  'キューのデータ数をカウントする
52  
53  count = c.count
54
55End Function
56Private Sub Class_Terminate()
57  'デストラクタ
58  
59  Set c = Nothing
60  
61End Sub

キューのテスト

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

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

 1Option Explicit
 2Sub test_Queue()
 3
 4On Error GoTo ErrorLabel
 5  
 6  Dim q As Queue
 7  Set q = New Queue 'Queueクラスをインスタンス化
 8  
 9  q.enqueue 1       '1をキューに追加する
10  q.enqueue 2       '2をキューに追加する
11  q.enqueue 3       '3をキューに追加する
12  MsgBox q.dequeue  '1をキューから取り出す
13  MsgBox q.dequeue  '2をキューから取り出す
14  MsgBox q.dequeue  '3をキューから取り出す
15  MsgBox q.dequeue  'エラー番号1000がraiseされる
16
17ErrorLabel:
18  If Err.Number = 1000 Then
19    MsgBox Err.Description, vbCritical, "エラー発生"
20  Else
21    MsgBox Err.Description, vbCritical, "エラー発生"
22  End If
23  
24End Sub

enqueueメソッドで1,2,3をキューに追加後dequeueメソッド4回実行しています。

最初に追加した1から、順番にデータを取り出していきます

:left
:left
:inline

 

4回目のdequeueメソッド実行時にデータがキューに存在しないので、エラーが発生します。
エラー番号は1000番で設定しています。

Github

https://github.com/kazusapg/vba_queue

関連ページ