VirtualTableクラスへのメソッドの追加[getFilteredArrayメソッド]
VirtualTableクラス続報
指定した条件を満たす配列を返すメソッド
任意の列の値が指定した値であるレコードだけを格納した配列を返すメソッドを作ってみた。
ひとまずコードを載っけておく。
getFilteredArrayメソッドのコード
リスト1-1 クラスモジュール
'///２次元配列（引数１）から任意の列（引数２）の値が、任意の値（引数３）である'
' 要素だけを抽出した２次元配列を返す'
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)'
'///ガード節。引数１が２次元配列でなかったらエラーを吐く。'
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
'２要素目以降は、配列を拡張してから要素を追加する'
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
で引数と返り値の設定。
冒頭のコメントにもあるように、
第１引数targetArrayが元になる配列、
第２引数targetColumnが抽出条件となる列、
第３引数targetValueが抽出条件となる値である。
返り値は配列なんだけれども、As Variant()とするといろいろ面倒なので、単にAs Variantとした。
(2)と(3)の
If Not isInitialized_ Then Call catchException(thrownException10001) If getArrayDimension(targetArray) <> 2 Then Call catchException(thrownException10002)
はコード内のコメントにもあるようにガード節。VirtualTableクラスのインスタンスのinitメソッドが未実行だったり、第１引数targetArrayが２次元配列でなかった場合にはエラーを吐くようにしている。コード内のcatchExceptionとかgetArrayDimensionというのは、クラス内で定義しているローカルメソッド。前者はエラーを吐くためのもの、後者は配列の次元数を返すもので、後者については、後のリスト1-2で紹介する。
で、(4)からがメソッドの本体。
(4)からの２行
Dim returnArray As Variant ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
で、抽出後の配列を格納する変数を準備する。
宣言後、即とりあえず１次元目の要素数を「1」、２次元目の要素数を元の配列と同じ数にしてReDimしておく。
(5)からの２行
Dim n As Long n = 1
では、Long型の変数 n を準備し、「1」で初期化。
これは、抽出後の配列の１次元目のインデックスとして用いる。
(6)からの10行（コメント除く。実質９行）
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が２以上になっていると、その都度expand2DimentionalArrayメソッドを用いて配列の１次元目の上限を１だけ拡張する。
expand2DimentionalArrayメソッドもクラス内のローカルメソッド。こちらは後のリスト1-3で紹介する。
配列の拡張ができたら、(8)からの３行（コメント除く）
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
説明がメンドクサイので説明は省略する。
第１引数targetArrayで元の配列、第２引数addRowsで１次元目の拡張数を受け取って、元の配列の１時限目の要素数をaddRows個だけ拡張した配列を返す、というもの。
いちおう、addRowsで負の数が渡されても良いようにはしてある（テスト不足なので、こんなに強気に言い切っていいのかどうかは不明）。
使ってみる
ワークシートにこんな表を用意しておく。
で、次のコードで実験。
リスト２ 標準モジュール
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メソッドで表を２次元配列として格納したら、(1)の
Call .getFilteredArray(targetArray:=.tableArray, _
targetColumn:=3, _
targetValue:="千葉県")
でgetFilteredArrayを実行する。
第１引数のtableArrayというのは、VirtualTableクラスのプロパティで、initメソッドで渡した配列を返す、と思ったら良い。
第２引数targetColumnに「3」、第３引数targetValueに「千葉県」を渡しているので、元の表のＣ列が「千葉県」になっているレコードだけを抽出して格納した２次元配列が作成されることになる。
(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
で、抽出されてできた配列の１列目をイミディエイトに出力させるようにした。
実行結果
こんなふうに表示された。
元の表をフィルターで抽出してみると、
この通り。意図どおりの結果となっていた。
おわりに
すでに、複数条件に対応したメソッドも作成済みです。
