VBA ListRowを使いやすくするクラス
はじめに
ListRow オブジェクト (Excel) はExcelのテーブルの行を表すオブジェクトです。
自分のテーブル(ListObject)の使い方
ワークシート関数のVLOOKUPのようなことをマクロから行うことが多いです。
単純な検索であればVLOOKUPやMATCH+INDEX関数で大丈夫ですが、 複数の列から同時に情報を取得したい、検索条件を柔軟にしたいと言った理由からマクロを使っています。
以上のような操作を行う場合
まずは以下のように対象の列の値の範囲を取得し、検索値がどの行にあるのかを探します。
ListObject.ListColumns.Item(検索する値の列見出し).DataBodyRange '検索処理...
行番号が見つかったら、以下のように値を取得していきます。
ListObject.ListColumns.Item(取得したい見出し1).DataBodyRange.Item(行番号).Value() ListObject.ListColumns.Item(取得したい見出し2).DataBodyRange.Item(行番号).Value() '…
…はい、やけに長ったらしくなりますね。
Withを使えば多少は短くなりますが、ListColumns.Item().DataBodyRange.Item()
と結構深く掘る必要があるのが面倒です。
またListColumnと対をなすListRowの方では列見出しから値を取得するすることができません。
ならばListRowから列見出しで値を取得できるようにすればいいじゃないか? という事でそのためのクラスを作成しました。
クラス本体
以下のコードをListRow2
という名前のクラスモジュールに貼り付けてください。
Option Explicit Implements Excel.ListRow Public Base As Excel.ListRow '列の番号or見出しから該当するセルを取得する Function Item(Index As Variant) As Excel.Range 'Attribute Item.VB_UserMemId = 0 Set Item = getItem(Me, Index) End Function Private Function getItem(this As ListRow2, Index As Variant) As Excel.Range Set getItem = this.Parent.ListColumns.Item(Index).DataBodyRange.Item(this.Index) End Function '以下は既存のメンバーのラップ用 Private Sub ListRow_Delete(): Call Base.Delete: End Sub Sub Delete(): Call Base.Delete: End Sub Private Property Get ListRow_Application() As Application: Set ListRow_Application = Base.Application: End Property Property Get Application() As Excel.Application: Set Application = Base.Application: End Property Private Property Get ListRow_Creator() As XlCreator: Let ListRow_Creator = Base.Creator: End Property Property Get Creator() As Excel.XlCreator: Let Creator = Base.Creator: End Property Private Property Get ListRow_Index() As Long: Let ListRow_Index = Base.Index: End Property Property Get Index() As Long: Let Index = Base.Index: End Property Private Property Get ListRow_InvalidData() As Boolean: Let ListRow_InvalidData = Base.InvalidData: End Property Property Get InvalidData() As Boolean: Let InvalidData = Base.InvalidData: End Property Private Property Get ListRow_Parent() As Object: Set ListRow_Parent = Base.Parent: End Property Property Get Parent() As Excel.ListObject: Set Parent = Base.Parent: End Property Private Property Get ListRow_Range() As Range: Set ListRow_Range = Base.Range: End Property Property Get Range() As Excel.Range: Set Range = Base.Range: End Property
使用例
新規ブックに以下のコードと上記のクラスを貼り付けて実行してみてください(既存のブックだと一枚目のワークシートが強制的に書き換えられます)。
なお、コード中で作成しているテーブルの中身は以下の記事を参考に作成しています。
Sub SampleListRow2() Dim ws As Excel.Worksheet Set ws = Excel.ThisWorkbook.Worksheets.Item(1) 'テーブルの準備 'テーブルの中身。配列定数をEvaluate tableData = [{"果物","いちご","150";"果物","ばなな","100";"果物","りんご","200";"野菜","キャベツ","150";"野菜","なすび","100";"野菜","レタス","120";"肉","牛肉","300";"肉","豚肉","200";"肉","鶏肉","100"}] ws.UsedRange.Clear With ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2)) .Value() = tableData Dim table As Excel.ListObject Set table = ws.ListObjects.Add(xlSrcRange, .Cells) End With 'ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2)) With table .ShowHeaders = True .HeaderRowRange.Value() = VBA.Split("種目,品名,価格", ",") End With 'table '検索して値の取得 'りんごについて、種目と価格を知りたい場合 Dim nameCol As Excel.ListColumn Set nameCol = table.ListColumns.Item("品名") 'Matchで手抜き検索 Dim appleIndex As Long appleIndex = Excel.WorksheetFunction.Match("りんご", nameCol.DataBodyRange, 0) '通常の場合 With table.ListColumns Debug.Print "種目", .Item("種目").DataBodyRange.Item(appleIndex).Text '←最後でインテリセンスが切れる Debug.Print "価格", .Item("価格").DataBodyRange.Item(appleIndex).Value() End With '自作クラスを使った場合 Dim appleRow As ListRow2 Set appleRow = New ListRow2 Set appleRow.Base = table.ListRows.Item(appleIndex) Debug.Print "種目", appleRow.Item("種目").Text '←最後までインテリセンスが効く Debug.Print "価格", appleRow.Item("価格").Value() Stop End Sub
その他
Excel.ListRow
をImplementsできたのでクラス化しましたが、getItem
だけを関数にしてもいい気がします。
こういった「既存のクラスを拡張したい」時に .NET Frameworkの拡張メソッドがうらやましくなります。
VBA用LINQ(作成中)
VBAでLINQ to Objects 「っぽい」ことができるものを作成中。
→OneDrive内の「M_Sample」モジュール
GitHub - imihito/VBALinq(碌に使ったことがないのでちゃんと使えてるかどうか…)
基本方針
やりたいこと
VBAで要素の集合に対してLINQ to Objects 「風」に処理をしたい。
考えないこと
型安全性
ダックタイピング上等、レイトバインディング・リフレクション万歳!の精神。
遅延実行
処理自体の遅延は出来そうだけど、処理が面倒になりそうなので考えない。
処理速度
現状(170820)では、効率の悪い処理をしているがとりあえず置いておく。
モジュール構成案
- 各種LINQ風メソッドを持つクラス
- デリゲートとして使うためのクラス群(後述)
- 補助処理を入れた標準モジュール
VBAに無い要素と代替案
IEnumerableインターフェイス
対象要素が列挙可能かどうかわからないので、とりあえずFor Eachしてみる。
作成するクラスにはVBA.Collectionを内蔵させて、そのイテレータを使ってFor Eachができるようにする。
デリゲート
「実行可能な処理」を示すインターフェイスと、それを実装したクラス群を作成し、そのクラス群を組み合わせて処理を示す形とする。
VBS用配列ラッパークラス
はじめに
VBScriptではVBA.Collectionをインスタンスできないため、複数の要素をまとめて扱うのが少し面倒。
配列を元に、Collection風に使えるVBScript用クラスをざっくり作ってみたのでメモ。
クラス本体
Class ArrayCol '内部格納の配列 Private clsArray 'As Variant '現在の要素数 Private UsedCount 'As Long Private Sub Class_Initialize() Call Me.Clear End Sub Public Sub Clear() UsedCount = 0 ReDim clsArray(4) End Sub '配列の下限 Private Property Get ARRAY_BASE() 'As Long ARRAY_BASE = 1 End Property '添え字変換 Private Function UserIndexToRealIndex(Index) 'As Long UserIndexToRealIndex = Index - ARRAY_BASE End Function '要素を追加する。 Public Sub Add(iItem) If UBound(clsArray) = UserIndexToRealIndex(UsedCount) Then Call ArrayExpand AssignVal clsArray(UsedCount), iItem UsedCount = UsedCount + 1 End Sub Private Sub ArrayExpand() ReDim Preserve clsArray(UBound(clsArray) * 2) End Sub '代入簡略化処理 Private Sub AssignVal(ByRef o, i) If IsObject(i) Then Set o = i Else o = i End If End Sub Public Default Property Get Item(ByVal Index) 'As Variant AssignVal Item, clsArray(UserIndexToRealIndex(Index)) End Property Public Property Let Item(ByVal Index, Value) clsArray(UserIndexToRealIndex(Index)) = Value End Property Public Property Set Item(ByVal Index, Value) Set clsArray(UserIndexToRealIndex(Index)) = Value End Property Public Property Get Count() 'As Long Count = UsedCount End Property Public Sub Remove(ByVal Index) Dim i For i = UserIndexToRealIndex(Index) To UserIndexToRealIndex(UsedCount - 1) AssignVal clsArray(i), clsArray(i + 1) Next 'i clsArray(UserIndexToRealIndex(UsedCount)) = Empty UsedCount = UsedCount - 1 End Sub '既存の配列で初期化する。 Public Sub InitByArray(BaseArray) If Not IsArray(BaseArray) Then Err.Raise 5 Me.Clear Dim tmp For Each tmp In BaseArray Me.Add tmp Next 'tmp End Sub Public Function ToArray() 'As Variant Dim buf: buf = clsArray ReDim Preserve buf(UserIndexToRealIndex(UsedCount)) ToArray = buf End Function End Class
実装メンバー
Clear
初期化用。
Add
要素を末尾に追加。
Item
添え字で要素を取得。 上記のコードでは添え字は1からはじまる。 範囲外アクセス時の動作は保証しない。
Count
要素数。1から数えた場合の数。
Remove
指定された添え字の要素を除去する。 除去したらその分自動で詰める。
InitByArray
指定した配列で初期化する。 適当実装。
ToArray
配列化する。 For Eachの場合や配列そのものが欲しい場合なんかに。
使用例
Option Explicit Dim myArray 'As ArrayCol Set myArray = New ArrayCol With myArray .Add 1 .Add 3.14 .Add "文字列" .Add Now() .Add WScript.ScriptFullName .Add New ArrayCol End With 'myArray MsgBox myArray(1) Dim buf: buf = "" Dim tmp For Each tmp In myArray.ToArray() If IsObject(tmp) Then buf = buf & TypeName(tmp) & vbCrLf Else buf = buf & tmp & vbCrLf End If Next 'tmp MsgBox buf 'Class ArrayCol '~
ネタのメモ
現状興味があること、書きたいことのメモ(170509更新)。 どの程度形になるか…。
勉強中
- XML・DOM操作(VBA・.NET)
- WPF
- UI Automation
- HTML・CSS・JavaScript全般
ネタ
- 文字列の中に特定の文字列が何回出現するのかの数え方(Splitと自作関数)
- PowerShellでのGUIアプリケーションについての個人的感想
- PowerShellでExcelに子フォームを表示する
- ExcelとPowerPointアドインの違いとかについて
考え中・調査中
自己紹介的なもの
今更ながら初投稿です。
ブログの内容
プログラミング関係の記事がメインになると思います。
Qiitaにも投稿しているので使い分けを迷っていますが、ある程度まとまった内容はQiita、メモ書きなどははてなブログに書いていこうかと考えています。
自分の環境
プログラミング系の職場ではありませんが、業務の一部としてVBAを触る機会があります。
職場の端末からはインターネット接続禁止、会社敷地内への携帯持ち込み非推奨、のためソフト組み込みヘルプや書籍、脳内メモリだけが頼りです。
勉強中(予定)の言語(≒職場で使える言語)
- VBA
- PowerShell
- VBScript
- HTML
- CSS
- JScript