今回はVBAでちょっと扱いにくいExcelのテーブル(ListObject)をクラスモジュールで包んで簡単に操作できるようにするコードを紹介。
作り方
まずVBEで対象のブックを選択し、挿入メニューからクラスモジュールを挿入する。
挿入されたクラスモジュール(Class1)を選択し、プロパティウインドウ(表示されてなければF4キーで表示)から、モジュールのオブジェクト名を「TableOperator」に変更する。
クラスモジュールTableOperatorをダブルクリックで開き、コードウインドウに以下のコードを張り付ける。
Option Explicit Public ListObject As ListObject Public OverwriteExtraBlankRecord As Boolean Public ReadExtraBlankRecord As Boolean Private rowCursor As Long Sub MoveFirst() rowCursor = 0 End Sub Sub SetTable(start_cell As Range) Set Me.ListObject = start_cell.ListObject Me.MoveFirst End Sub Function GetNext() As Range rowCursor = rowCursor + 1 Set GetNext = Me.ListObject.ListRows(rowCursor).Range End Function Function HasNext() As Boolean If ReadExtraBlankRecord Then HasNext = rowCursor < Me.ListObject.ListRows.Count Else HasNext = rowCursor < GetLastUsedRowIndex End If End Function Private Function IsBlank(target_range As Range) As Boolean Dim arr: arr = target_range.Value Dim r For Each r In arr 'If r = Empty Then ←12/5 1:01修正。 'TwitterでimihitoさんにEmptyとの比較だと0もTrueになる旨の指摘と改善コード教えてもらいました。 If IsEmpty(r) Then IsBlank = True Exit For End If Next End Function Private Function GetLastUsedRowIndex() As Long Dim ret As Long ret = Me.ListObject.ListRows.Count Do While IsBlank(Me.ListObject.ListRows(ret).Range) ret = ret - 1 Loop GetLastUsedRowIndex = ret End Function Sub AddItem(ParamArray data()) If UBound(data) + 1 = Me.ListObject.ListColumns.Count Then Dim targetRange As Range If OverwriteExtraBlankRecord Then Dim cursor As Long cursor = GetLastUsedRowIndex + 1 If cursor < Me.ListObject.ListRows.Count Then Set targetRange = Me.ListObject.ListRows(cursor).Range Else Set targetRange = Me.ListObject.ListRows.Add.Range End If Else Set targetRange = Me.ListObject.ListRows.Add.Range End If Dim i As Long For i = LBound(data) To UBound(data) targetRange.Item(i + 1).Value = data(i) Next End If End Sub
使い方
今のところ機能はデータの追加と、全データの列挙だけ。
初心者用に説明を書こうと思ったけれど、本文での説明が面倒だったのでサンプルコードはいつもよりコメント多め。
データの追加
今回は以下の食材テーブルに新しく、魚を追加するサンプルを作った。
↓コピペ用の表はこちら
種目 | 品名 | 価格 |
果物 | いちご | 150 |
果物 | ばなな | 100 |
果物 | りんご | 200 |
野菜 | キャベツ | 150 |
野菜 | なすび | 100 |
野菜 | レタス | 120 |
肉 | 牛肉 | 300 |
肉 | 豚肉 | 200 |
肉 | 鶏肉 | 100 |
※Excelに貼り付けてテーブル化してください。
※標準モジュールに書くコードは以下を参照してください。
Sub データ追加() 'まず任意の変数を、TableOperator型で宣言します。 Dim foods As TableOperator '次にその変数に新しいTableOperatorを代入します。 Set foods = New TableOperator 'そして、SetTableメソッドにテーブルの開始セルを指定すると、準備完了です。 foods.SetTable Range("A1") '↓これは記事中で解説します。 foods.OverwriteExtraBlankRecord = True 'あとは、データを指定して追加するだけ。 foods.AddItem "魚", "いわし", 100 foods.AddItem "魚", "あじ", 150 foods.AddItem "魚", "さば", 200 End Sub
OverwriteExtraBlankRecordプロパティについて
※前置きが長くなるけれども、しばしお付き合いください。
Excelのテーブル機能はふつう、先に示したようにデータをぎりぎりまで入力する想定で作られている。
ただ悲しいかな一般的にテーブルの機能は正しく認知されておらず、ただのデザイン機能だと思って使ってる方も多い。
それで、以下のようにデータの追加に備えてテーブルに余裕を持たせておくなんてことが行われるのだが、、、
これがVBAでテーブルを扱う際の悲劇の始まり。
Excelはテーブル範囲=データ範囲だと認識するため、上の画像では2~18行目まで17個のデータが入っていると認識する。
そこにデータをAddすると、当然こうなる↓
本来は、「テーブル機能をきちんと理解する」という根本解決がベストだけれど、共有で使っているファイルなんかだとなかなか全員に周知徹底も難しい。
そこで!
長くなったけれど、OverwriteExtraBlankRecordの出番。
というかもう答え出たね。
そう、これは私が用意した、余分な空行を上書きするという意味のプロパティ。
デフォルトだとFalseだけれど、Trueにすることでこのとおり↓
ちゃんと狙った位置に入る。
全データ出力
全データを出力するサンプルはこちら。
※Debug.Printを使用しているので、イミディエイトウインドウが表示されていなければ「Ctrl+G」で表示させておいてください。
Sub 全データ出力() Dim foods As TableOperator Set foods = New TableOperator foods.SetTable Range("A1") 'ここまでの準備は一緒 '最初の行へ移動 foods.MoveFirst 'ReadExtraBlankRecordをTrueにすると余分な空行も含めて出力。デフォルトはFalse '↓サンプルを示す目的なので一旦コメントアウトしている。 'foods.ReadExtraBlankRecord = True Debug.Print "---start---" 'HasNextがTrueの間、GetNextを繰り返す。 Do While foods.HasNext 'GetNextは1レコード分のRangeを返し、内部で保持しているカーソルを次の行へ移す。 Dim food As Range Set food = foods.GetNext '返ってきたRangeに引数をひとつ与えると、その列のデータが取れるので、 'Tabでくっつけて表示 Debug.Print food(1) & vbTab & food(2) & vbTab & food(3) Loop Debug.Print "---end---" End Sub
初心者向け(?)の解説は以上。
ここから下は余談。
改善が望まれる個所
- HasNextが呼ばれるたびにGetLastUsedRowIndexが実行されるので効率が悪い。
- Whereなどのメソッドでデータの絞り込みがしたい。
これは条件が1つなら実現したのだけど、複数条件を付けたくなったところで面倒臭くなって詰んだ。
※私はこれ以上つくりません。一応、コードの残骸を掲載しておくので好きにしてください。
あくまで残骸なので、このままではただのDebug.Printです。
クラスモジュールTableOperatorに追加するコード
Private Function compare(value As Variant, condition As String) As Boolean Dim ret As Boolean Dim op As String: op = Split(condition)(0) Dim cond As Variant: cond = Mid(condition, InStr(1, condition, " ") + 1) Select Case TypeName(value) Case "String": cond = CStr(cond) Case "Date": cond = CDate(cond) Case "Long": cond = CLng(cond) Case "Integer": cond = CInt(cond) Case "Double": cond = CDbl(cond) Case "Currency": cond = CCur(cond) Case "Single": cond = CSng(cond) Case "Boolean": cond = CBool(cond) Case "Byte": cond = CByte(cond) End Select Select Case op Case "=": ret = value = cond Case ">": ret = value > cond Case "<": ret = value < cond Case ">=": ret = value >= cond Case "<=": ret = value <= cond Case "<>": ret = value <> cond Case "Like": ret = value Like cond Case Else: ret = False End Select compare = ret End Function Function Whare(column_name As String, condition As String) As Range Dim columnindex, i, j columnindex = Me.ListObject.ListColumns(column_name).Index For i = 1 To Me.ListObject.ListRows.Count If compare(Me.ListObject.ListRows(i).Range(columnindex).value, condition) Then For j = 1 To Me.ListObject.ListColumns.Count Debug.Print Me.ListObject.ListRows(i).Range(j).value, Next Debug.Print End If Next End Function
用意するテーブル
サンプルコード
Sub フィルターテスト() Dim foods As TableOperator Set foods = New TableOperator foods.SetTable Range("A1") Debug.Print "----" foods.Whare "価格", "<= 100" Debug.Print "----" foods.Whare "種目", "= 魚" Debug.Print "----" foods.Whare "種目", "= 果物" Debug.Print "----" foods.Whare "品名", "Like *ご" End Sub
以上