追記。改善版を作りました♪こちらのコードの方がすっきりとしております。
エクセルワークシートにマスタデータを表現いたしました。
これを、VBA に取り込んで、VBA の他のコードから呼び出して検索して値を返すクラスを作りたいですの！
そのようにすることで、エクセルのワークシートから値を取得して何かの関数で絞り込んで、、、などと意識することなくマスタデータを取り出せるようにいたします♪
ポイント
- マスタデータをユーザ定義型の Collection で扱おうと考えたが使えなかった。
- そこでクラス内にマスタの項目をプロパティとして定義する。そして自分自身のクラスをインスタンス化してマスタデータをプロパティに設定することでデータを扱えるようにする。
- 自分自身のクラスには、データ構造以外に関数も含まれる。
- 本来であれば構造を扱うクラス、処理を扱うクラスに分けるべき。
- しかし、VBA にはクラス宣言のコードがないため、1つのファイルに両方を持たせるためにこれらを混在させた。
エクセルデータ
次のエクセル表をマスタデータとして扱うことといたします。
- シート名: Sheet1
- 1行目もエクセルに含める。
- A1 セルから始まる。
| No | 曜日 | 時刻(以降) | 時刻(未満) | 料金 |
|---|---|---|---|---|
| 1 | 月,火,水,木,金 | 9:00:00 | 12:00:00 | 1000 |
| 2 | 月,火,水,木,金 | 13:00:00 | 18:00:00 | 2000 |
| 3 | 月,火,水,木,金 | 18:00:00 | 21:00:00 | 3000 |
| 4 | 土 | 9:00:00 | 12:00:00 | 1200 |
| 5 | 土 | 13:00:00 | 18:00:00 | 2200 |
| 6 | 土 | 18:00:00 | 21:00:00 | 3200 |
| 7 | 日 | 9:00:00 | 12:00:00 | 1500 |
| 8 | 日 | 13:00:00 | 18:00:00 | 2500 |
| 9 | 日 | 18:00:00 | 21:00:00 | 3500 |
VBA コード
- マスタデータを、mcolReaded と mcolFiltered の 2 つのコレクションに保持させている。
- mcolReaded にはエクセルから読み込んだデータをそのまま変更しないで保持させている。
- mcolFiltered には条件で絞り込んで残ったデータを残している。
- 何度でも絞り込めるように、結果の取得が終わったら mcolFiltered に mcolReaded をコピーしてリセットしている。
- Init メソッドでやっていること
- ワークシートからデータを読み込み、
- 行ごとにループするときに自分自身のクラスをインスタンス化してプロパティに対応するエクセルデータを設定し、
- インスタンスをコレクションに追加している。
- Filter メソッドでの判定について
- 列項目分だけ判定しているため、増減があれば If の判定内容も合わせるようにコードを書き直す必要がある。
- If 内のすべての要素が評価されるため、False となった時点で判定を止めたい場合は If の中身ごとメソッドに切り出せば良さそう。
- 曜日は InStr メソッドで、含まれているかどうかを判定
- 時刻は比較演算子で大小判定
Option Explicit Private mcolReaded As Collection Private mcolFiltered As Collection ' 自身のクラスをモデルとして扱いたい。 ' インスタンス化したときに値を設定できるように、Public に設定 Public mlngNo As Long Public mstrWeekday As String Public mdtmFrom As Date Public mdtmTo As Date Public mlngPrice As Long ''' <summary> ''' コンストラクタ ''' </summary> Private Sub Class_Initialize() Set mcolReaded = New Collection Set mcolFiltered = New Collection End Sub ''' <summary> ''' 初期化処理を実行します。 ''' </summary> ''' <param name="strTartgetWorksheet">捜査対象ワークシート</param> Public Sub Init(ByVal strTartgetWorksheet As String) ' 変数をセット Dim objSheet As Worksheet: Set objSheet = Worksheets(strTartgetWorksheet) With objSheet ' 下端の行番号、右端の列番号を取得 Dim lngMaxRow As Long: lngMaxRow = .Cells(Rows.Count, 1).End(xlUp).Row Dim lngMaxCol As Long: lngMaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column ' マスタデータ部分を取得。1行目はヘッダーのため無視 Dim objMaster As Range Set objMaster = .Range(.Cells(2, 1), Cells(lngMaxRow, lngMaxCol)) End With ' マスタデータのクラスコレクション生成 Dim i As Long For i = 1 To objMaster.Rows.Count Dim udtRow As PriceTable: Set udtRow = New PriceTable With udtRow .mlngNo = objMaster(i, 1) .mstrWeekday = objMaster(i, 2) .mdtmFrom = objMaster(i, 3) .mdtmTo = objMaster(i, 4) .mlngPrice = objMaster(i, 5) End With Call mcolReaded.Add(udtRow) Next i ' フィルタ対象用にデータをコピー Set mcolFiltered = mcolReaded End Sub ''' <summary> ''' 引数を条件として絞り込んだ料金を返却します。 ''' 結果が複数ある場合は、最初の料金を返却します。 ''' 絞込結果が 0 件の場合は、0 を返却します。 ''' </summary> ''' <param name="strWeekday">曜日</param> ''' <param name="dtmTime">時刻</param> ''' <returns>料金</returns> Public Function GetPrice( _ ByVal strWeekday As String, _ ByVal dtmTime As Date) As Long Call Filter(strWeekday, dtmTime) GetPrice = GetPriceAndReset End Function ''' <summary> ''' 絞込処理を実行します。 ''' </summary> ''' <param name="strWeekday">曜日</param> ''' <param name="dtmTime">時刻</param> Private Sub Filter( _ ByVal strWeekday As String, _ ByVal dtmTime As Date) Dim colResults As Collection Set colResults = New Collection Dim target As PriceTable For Each target In mcolFiltered If Instr(target.mstrWeekday, strWeekday) > 0 And _ (target.mdtmFrom <= dtmTime And target.mdtmTo > dtmTime) Then Call colResults.Add(target) End If Next target Set mcolFiltered = colResults End Sub ''' <summary> ''' 絞り込まれた金額を返却します。 ''' その後、メモリに読み込んだマスタの状態をフィルタ前に戻します。 ''' 結果が複数ある場合は、最初の料金を返却します。 ''' 絞込結果が0件の場合は、0を返却します。 ''' <returns>料金</returns> Private Function GetPriceAndReset() As Long GetPriceAndReset = 0 If mcolFiltered.Count > 0 Then GetPriceAndReset = mcolFiltered(1).mlngPrice End If ' マスタデータのコレクションをリセット Set mcolFiltered = mcolReaded End Function Public Function ToString() As String Dim s As String Dim v As PriceTable For Each v In mcolFiltered s = s & _ v.mlngNo _ & ", " & v.mstrWeekday _ & ", " & v.mdtmFrom _ & ", " & v.mdtmTo _ & ", " & v.mlngPrice & vbCrLf Next v ToString = s End Function
動きの確認用コード
Option Explicit
Public Sub Test()
Dim pt As PriceTable
Set pt = New PriceTable
Call pt.Init("Sheet1")
Debug.Print pt.ToString
Debug.Print "予想: 月、21:00 ⇒ 検索結果無しで0円。結果: " & pt.GetPrice("月", #9:00:00 PM#) & "円"
Debug.Print "予想: 月、10:15 ⇒ 1000円。結果: " & pt.GetPrice("月", #10:15:00 AM#) & "円"
Debug.Print "予想: 火、13:00 ⇒ 2000円。結果: " & pt.GetPrice("火", #1:00:00 PM#) & "円"
Debug.Print "予想: 火、12:00 ⇒ 2000円。結果: " & pt.GetPrice("火", #1:00:00 PM#) & "円"
Debug.Print "予想: 水、18:00 ⇒ 3000円。結果: " & pt.GetPrice("水", #6:00:00 PM#) & "円"
Debug.Print "予想: 木、9:00 ⇒ 1000円。結果: " & pt.GetPrice("木", #9:00:00 AM#) & "円"
Debug.Print "予想: 金、17:59 ⇒ 2000円。結果: " & pt.GetPrice("金", #5:59:59 PM#) & "円"
Debug.Print "予想: 土、20:59 ⇒ 3200円。結果: " & pt.GetPrice("土", #8:59:59 PM#) & "円"
Debug.Print "予想: 土、11:59 ⇒ 1500円。結果: " & pt.GetPrice("日", #11:59:59 AM#) & "円"
End Sub
結果
1, 月,火,水,木,金, 9:00:00, 12:00:00, 1000 2, 月,火,水,木,金, 13:00:00, 18:00:00, 2000 3, 月,火,水,木,金, 18:00:00, 21:00:00, 3000 4, 土, 9:00:00, 12:00:00, 1200 5, 土, 13:00:00, 18:00:00, 2200 6, 土, 18:00:00, 21:00:00, 3200 7, 日, 9:00:00, 12:00:00, 1500 8, 日, 13:00:00, 18:00:00, 2500 9, 日, 18:00:00, 21:00:00, 3500 予想: 月、21:00 ⇒ 検索結果無しで0円。結果: 0円 予想: 月、10:15 ⇒ 1000円。結果: 1000円 予想: 火、12:00 ⇒ 2000円。結果: 2000円 予想: 水、18:00 ⇒ 3000円。結果: 3000円 予想: 木、9:00 ⇒ 1000円。結果: 1000円 予想: 金、17:59 ⇒ 2000円。結果: 2000円 予想: 土、20:59 ⇒ 3200円。結果: 3200円 予想: 日、11:59 ⇒ 1500円。結果: 1500円
ユーザ定義型が使えないとわかるまで調べたことまとめ
ユーザ定義型、Type が使えれば、自分自身のクラスをインスタンス化する必要もなく、もう少しすっきりとしたコードが書けたと存じます＞＜。悔しいということもあり、諦めるまでにわかったことを残しておきますの♪
- ユーザ定義型、Type、構造体
- Private であろうが Public であろうが、 Type を定義しても Collection には Type を追加できない。次のエラーとなった。
コンパイルエラー:
パブリック オブジェクト モジュールで定義されたユーザー定義型に限り、変数に割り当てることができ、実行時バインディングの関数に渡すことができます。
- クラスモジュールでは、Public の Type を使用できない。次のエラーとなった。標準モジュールでは Public の Type の使用可能
コンパイルエラー:
オブジェクト モジュール内では、パブリック ユーザー定義型は定義できません。
おわりに
ワークシートから読み込んだデータをどのようにメモリに保持するとよいかという点で、苦労いたしました。
Range は 2 次元配列の形でデータを取得できるため、1 次元目を別の配列に追加することで絞り込んで、、、などと操作を行いたかったのですけれども、できませんでしたの＞＜。
次のページを参考にして、なんとか取り込んだ 2 次元配列のまま操作できないかしらと思ったのですけれども、途中で方針を転換いたしました＞＜。
2 次元配列のままでの操作の難易度が高そうと感じ始めた頃、ユーザー定義型、つまり Type の存在を知りました！
配列ではデータを扱いづらいですし、クラスモジュールにマスタのモデルを定義しますと複数のファイルに別れてしまいますし、、、と感じた欠点を Type は補うことができますの！
と思って試しましたけれども、ダメでしたの＞＜。
結局、1つのクラスにモデルも処理も定義し、自身をインスタンス化することで実現いたしました♪試行錯誤、時間がかかってしまいますのが難点ですけれども＞＜、楽しいですの♪
以上です。