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

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

ExcelVBAのクラスモジュールって何?という人向けの使い方まとめ
Excelのクラスモジュールを使ったプロパティ設定の書き方、サブルーチンの使い方などを、図解を交えてまとめました。標準モジュールの使い方に慣れてきて、もうちょっとステップアップしたい中級者向けです。
キューの構造
キューはデータ構造の一種です。
FIFO(First In First Out)といわれる
最初に入れたデータが、最初に取り出される構造になっています。
キューにデータを入れる操作をenqueue(エンキュー)
キューからデータを取り出す操作をdequeue(デキュー)といいます。
実装する機能
今回はクラスモジュールを使用して、下記の機能を実装してみます。
- キューの末尾にデータを追加するenqueue(エンキュー)
- キューに存在する先頭のデータを取り出すdequeue(デキュー)
- キューに存在するデータ数をカウントするcount(カウント)
キューの実装
クラスモジュールを追加します。
追加されたクラスモジュール名をClass1からQueueに変更します。
Queueクラスのコードは以下になります。
Collection型を利用してキューを実装しています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
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クラスをテストするコードは以下になります。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
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 |
enqueueメソッドで1,2,3をキューに追加後
dequeueメソッド4回実行しています。
最初に追加した1から、順番にデータを取り出していきます
4回目のdequeueメソッド実行時にデータがキューに
存在しないので、エラーが発生します。
エラー番号は1000番で設定しています。
Github
GitHub - kazusapg/vba_queue
Contribute to kazusapg/vba_queue development by creating an account on GitHub.
コメント