VirtualTableクラスへのメソッドの追加[getFilteredArrayメソッド]
VirtualTableクラス続報
指定した条件を満たす配列を返すメソッド
任意の列の値が指定した値であるレコードだけを格納した配列を返すメソッドを作ってみた。
ひとまずコードを載っけておく。
getFilteredArrayメソッドのコード
リスト1-1 クラスモジュール
'///2次元配列(引数1)から任意の列(引数2)の値が、任意の値(引数3)である' ' 要素だけを抽出した2次元配列を返す' Public Function getFilteredArray( _ ByRef targetArray As Variant, _ ByVal targetColumn As Long, _ ByVal targetValue As Variant) As Variant '……(1)' '///ガード節。未初期化ならエラーを吐く。' If Not isInitialized_ Then _ Call catchException(thrownException10001) '……(2)' '///ガード節。引数1が2次元配列でなかったらエラーを吐く。' If getArrayDimension(targetArray) <> 2 _ Then Call catchException(thrownException10002) '……(3)' On Error GoTo errorHandler Dim returnArray As Variant '……(4)' ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2)) Dim i As Long Dim j As Long Dim n As Long '……(5)' n = 1 For i = LBound(targetArray, 1) To UBound(targetArray, 1) '……(6)' If targetArray(i, targetColumn) = targetValue Then '2要素目以降は、配列を拡張してから要素を追加する' If n > 1 Then returnArray = _ expand2DimentionalArray(returnArray, 1) '……(7)' For j = LBound(targetArray, 2) To UBound(targetArray, 2) '……(8)' '各列の要素を追加' returnArray(n, j) = targetArray(i, j) Next n = n + 1 '……(9)' End If Next isFiltered_ = True filteredArray_ = returnArray '……(10)' getFilteredArray = returnArray: Exit Function errorHandler: '///配列の作成に失敗してエラーが出たら、既存のfilteredArray_を返す' getFilteredArray = filteredArray_ End Function
まずは(1)の
Public Function getFilteredArray( _ ByRef targetArray As Variant, _ ByVal targetColumn As Long, _ ByVal targetValue As Variant) As Variant
で引数と返り値の設定。
冒頭のコメントにもあるように、
第1引数targetArray
が元になる配列、
第2引数targetColumn
が抽出条件となる列、
第3引数targetValue
が抽出条件となる値である。
返り値は配列なんだけれども、As Variant()
とするといろいろ面倒なので、単にAs Variant
とした。
(2)と(3)の
If Not isInitialized_ Then Call catchException(thrownException10001) If getArrayDimension(targetArray) <> 2 Then Call catchException(thrownException10002)
はコード内のコメントにもあるようにガード節。VirtualTable
クラスのインスタンスのinit
メソッドが未実行だったり、第1引数targetArray
が2次元配列でなかった場合にはエラーを吐くようにしている。コード内のcatchException
とかgetArrayDimension
というのは、クラス内で定義しているローカルメソッド。前者はエラーを吐くためのもの、後者は配列の次元数を返すもので、後者については、後のリスト1-2で紹介する。
で、(4)からがメソッドの本体。
(4)からの2行
Dim returnArray As Variant ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
で、抽出後の配列を格納する変数を準備する。
宣言後、即とりあえず1次元目の要素数を「1」、2次元目の要素数を元の配列と同じ数にしてReDim
しておく。
(5)からの2行
Dim n As Long n = 1
では、Long型の変数 n を準備し、「1」で初期化。
これは、抽出後の配列の1次元目のインデックスとして用いる。
(6)からの10行(コメント除く。実質9行)
For i = LBound(targetArray, 1) To UBound(targetArray, 1) If targetArray(i, targetColumn) = targetValue Then If n > 1 Then returnArray = _ expand2DimentionalArray(returnArray, 1) '……(7)' For j = LBound(targetArray, 2) To UBound(targetArray, 2) '……(8)' '各列の要素を追加' returnArray(n, j) = targetArray(i, j) Next n = n + 1 '……(9)' End If Next
では、元の配列をループして条件に合致するかどうかを判定、条件に合致した行のデータをreturnArray
に格納している。
元の配列のtargetColumn
列目のデータがtargetValue
と一致していたら条件に合致したということ。
その場合は、(7)の
If n > 1 Then returnArray = _ expand2DimentionalArray(returnArray, 1)
でn
が2以上になっていると、その都度expand2DimentionalArray
メソッドを用いて配列の1次元目の上限を1だけ拡張する。
expand2DimentionalArray
メソッドもクラス内のローカルメソッド。こちらは後のリスト1-3で紹介する。
配列の拡張ができたら、(8)からの3行(コメント除く)
For j = LBound(targetArray, 2) To UBound(targetArray, 2) returnArray(n, j) = targetArray(i, j) Next
で元の表のi
行目の各列の値を、returnArrayのn
行目各列に格納する。
あとは、(9)の
n = n + 1
でn
をインクリメントする。
あとは、(10)の
filteredArray_ = returnArray getFilteredArray = returnArray: Exit Function
で、クラス内のPrivate変数filteredArray_
に抽出後の配列returnArray
をコピーした上でreturnArray
を返しておしまい。
お次に、このメソッド内から呼ばれるPriveteメソッドを紹介する。
リスト1-2 クラスモジュール
Private Function getArrayDimension( _ ByRef targetArray As Variant) As Long If Not IsArray(targetArray) _ Then getArrayDimension = False: Exit Function Dim n As Long n = 0 Dim tmp As Long On Error Resume Next Do While Err.Number = 0 n = n + 1 tmp = UBound(targetArray, n) Loop Err.Clear getArrayDimension = n - 1 End Function
これは、
このときに紹介したもの。それをそのまま使っている。
エラーが出ることを利用している、というのは余り健全ではないのかもしれないが、他に方法が思いつかない。
リスト1-3 クラスモジュール
Private Function expand2DimentionalArray( _ ByRef targetArray As Variant, _ ByVal addRows As Long) As Variant() Dim returnArray As Variant ReDim returnArray(LBound(targetArray, 1) To _ UBound(targetArray, 1) + addRows, _ LBound(targetArray, 2) To _ UBound(targetArray, 2)) Dim maxRowIndex As Long If addRows >= 0 Then maxRowIndex = UBound(targetArray, 1) Else maxRowIndex = UBound(returnArray, 1) End If Dim maxColumnIndex As Long maxColumnIndex = UBound(targetArray, 2) Dim i As Long Dim j As Long For i = LBound(targetArray, 1) To maxRowIndex For j = LBound(targetArray, 2) To maxColumnIndex returnArray(i, j) = targetArray(i, j) Next Next expand2DimentionalArray = returnArray End Function
説明がメンドクサイので説明は省略する。
第1引数targetArray
で元の配列、第2引数addRows
で1次元目の拡張数を受け取って、元の配列の1時限目の要素数をaddRows
個だけ拡張した配列を返す、というもの。
いちおう、addRows
で負の数が渡されても良いようにはしてある(テスト不足なので、こんなに強気に言い切っていいのかどうかは不明)。
使ってみる
ワークシートにこんな表を用意しておく。
で、次のコードで実験。
リスト2 標準モジュール
Public Sub testNewVirtualTable() Dim virtualTable_ As New VirtualTable With virtualTable_ Call .init(Sheet1.Range("A1").CurrentRegion) Call .getFilteredArray(targetArray:=.tableArray, _ targetColumn:=3, _ targetValue:="千葉県") '……(1)' Dim tmpArray As Variant tmpArray = .filteredArray '……(2)' Dim i As Long For i = LBound(tmpArray, 1) To UBound(tmpArray, 1) '……(3)' Debug.Print tmpArray(i, 1) Next End With Set virtualTable_ = Nothing End Sub
VirtualTable
クラスのインスタンスを生成し、init
メソッドで表を2次元配列として格納したら、(1)の
Call .getFilteredArray(targetArray:=.tableArray, _ targetColumn:=3, _ targetValue:="千葉県")
でgetFilteredArray
を実行する。
第1引数のtableArray
というのは、VirtualTable
クラスのプロパティで、init
メソッドで渡した配列を返す、と思ったら良い。
第2引数targetColumn
に「3」、第3引数targetValue
に「千葉県」を渡しているので、元の表のC列が「千葉県」になっているレコードだけを抽出して格納した2次元配列が作成されることになる。
(2)の
tmpArray = .filteredArray
は、変数tmpArray
にvirtualTable_.filteredArray
を代入する形になっている。
filteredArray
というのも、VirtualTable
クラスのプロパティで、getFilteredArray
メソッドの実行によって作成された配列が返るようになっている。
そもそもgetFilteredArray
メソッドがFunctionなので、ここは
tmpArray = .getFilteredArray(targetArray:=.tableArray, _ targetColumn:=3, _ targetValue:="千葉県")
と書いても良かったところ。
あとは、(3)の
For i = LBound(tmpArray, 1) To UBound(tmpArray, 1) Debug.Print tmpArray(i, 1) Next
で、抽出されてできた配列の1列目をイミディエイトに出力させるようにした。
実行結果
こんなふうに表示された。
元の表をフィルターで抽出してみると、
この通り。意図どおりの結果となっていた。
おわりに
すでに、複数条件に対応したメソッドも作成済みです。