VBA配列攻略3：Whereメソッドの実装

はじめに

前々回の記事で、配列操作を「Where / PickRows / DropRows」に分解する設計を紹介し
VBA配列攻略1：配列フィルタの設計を考える
前回の記事で、配列の添え字取得ヘルパー(TableBounds)の実装を行いました。
VBA配列攻略2：L/UBound を FirstRow/LastRow に置き換えて、コードでなくロジックに集中する

今回はその中核となる Whereメソッド を実装します。

本シリーズでは効率や処理速度より「人間が理解しやすい構造」を重視しています。そのため、処理を役割ごとに分解した結果、コード量やループ回数が増え非効率に見える場合があります。処理速度が実務に影響がない範囲（0.1秒が0.2秒になるなど）であれば許容していく考え方です。

Whereの役割

Whereは、条件に一致する「行番号」を取得するメソッドです。
「データ」ではなく「行番号」を返すことで、処理の再利用性を高めています。

入力：配列 + 条件
出力：行番号（Long配列）

このメソッド名はC# LINQのWhereに着想を得ていますが、LINQが「要素」を返すのに対し、本実装では「行番号」を返す点が異なります。
これにより、PickRowsなど他の処理と柔軟に組み合わせることができます。

サンプル

サンプルデータ

次のような配列データを考えます。左端の数字は配列の行番号を示しています。

Row  ID  Name    Price  Stock
0    ID  Name    Price  Stock
1    1   Apple    120    10
2    2   Orange    80    25
3    3   Banana   150     5
4    4   Grape    200    12

行 0 はヘッダーで、データは行 1 から始まります。
Whereではヘッダー行を除外します。そのため次のようにループします。

For r = tr.FirstRow + 1 To tr.LastRow

Whereの動作イメージ

次の条件を指定したとします。

Price > 100

一致する行は次の通りです。

Row
1
3
4

つまりWhereの戻り値は次のようになります。

rows = [1, 3, 4]
cnt  = 3

Whereはこのように、データではなく行番号のみを返します。
取得した行番号はPickRowsに渡すことで、該当データを抽出できます。

実装

比較演算子（Enum）

Whereの条件判定をシンプルに書くため、比較演算子をEnumで定義します。

Public Enum Operator
    opEqual      ' =
    opNotEqual   ' <>
    opGreater    ' >
    opGreaterEq  ' >=
    opLess       ' <
    opLessEq     ' <=
    opLike       ' Like
End Enum

列Index取得（FindColumnIndex）

列名指定に対応するため、ヘッダーから列Indexを取得する関数を用意します。

Public Function FindColumnIndex(ByRef vData As Variant, ByVal colName As String) As Long
    Dim tr As TableBounds
    tr = GetTableBounds(vData)
    
    Dim c As Long
    For c = tr.FirstCol To tr.LastCol
        If vData(tr.FirstRow, c) = colName Then
            FindColumnIndex = c
            Exit Function
        End If
    Next c

    '見つからない場合はエラー扱い（-1） ※
    FindColumnIndex = -1
End Function

Whereメソッド

シグネチャ

Public Function Where( _
    ByRef vData As Variant, _
    ByVal col As Variant, _
    ByVal op As Operator, _
    ByVal value As Variant, _
    ByRef result() As Long _
) As Long

• 戻り値：件数
• 0：該当なし（正常）
• -1：エラー（列不正など）

※補足：戻り値を配列（Long()）にしなかった理由
Whereは「該当なし（0件）」と「エラー（列不正など）」を区別する必要があります。
VBAでは空配列とエラーの区別が曖昧になるため、本実装では戻り値に件数を返す設計としています。

実装

Public Function Where( _
    ByRef vData As Variant, _
    ByVal col As Variant, _
    ByVal op As Operator, _
    ByVal value As Variant, _
    ByRef result() As Long _
) As Long

    Dim tr As TableBounds
    tr = GetTableBounds(vData)
    
    Erase result
    
    ' 列解決
    Dim colIndex As Long
    If VarType(col) = vbString Then
        colIndex = FindColumnIndex(vData, col)
    Else
        colIndex = CLng(col)
    End If
    
    ' 列が見つからない場合はエラー扱い（-1）　※
    If colIndex = -1 Then
        Where = -1
        Exit Function
    End If
    
    If colIndex < tr.FirstCol Or colIndex > tr.LastCol Then
        Where = -1
        Exit Function
    End If
    
    Dim count As Long
    count = 0
    
    Dim r As Long
    Dim cellValue As Variant
    
    ' ヘッダー行を除外
    For r = tr.FirstRow + 1 To tr.LastRow
        cellValue = vData(r, colIndex)
        
        If CompareValue(cellValue, op, value) Then
            count = count + 1
            
            If count = 1 Then
                ReDim result(1 To 1)
            Else
                ReDim Preserve result(1 To count) '2回目以降はPreserve
            End If
            
            result(count) = r
        End If
    Next r
    
    Where = count

End Function

比較処理（CompareValue）

型が異なる場合は文字列に変換して比較します（VBAの暗黙変換を避けるため）。

Private Function CompareValue(a As Variant, op As Operator, b As Variant) As Boolean

    Select Case op
        Case opEqual, opNotEqual
            Dim aType As VbVarType, bType As VbVarType
            aType = VarType(a)
            bType = VarType(b)

            ' 型が同じならそのまま比較
            If aType = bType Then
                If op = opEqual Then
                    CompareValue = (a = b)
                Else
                    CompareValue = (a <> b)
                End If
            Else
                ' 型が違う場合は文字列化して比較
                If op = opEqual Then
                    CompareValue = (CStr(a) = CStr(b))
                Else
                    CompareValue = (CStr(a) <> CStr(b))
                End If
            End If

        Case opLike
            CompareValue = (CStr(a) Like CStr(b))

        Case opGreater, opGreaterEq, opLess, opLessEq
            ' 数値チェック
            If Not IsNumeric(a) Or Not IsNumeric(b) Then
                Err.Raise vbObjectError + 1002, , "大小比較ですが a または b が数値ではありません。"
            End If

            Select Case op
                Case opGreater:    CompareValue = (a > b)
                Case opGreaterEq:  CompareValue = (a >= b)
                Case opLess:       CompareValue = (a < b)
                Case opLessEq:     CompareValue = (a <= b)
            End Select
    End Select

End Function

使用例

Whereメソッド

Dim rows() As Long
Dim cnt As Long

' 列Index指定
cnt = Where(vData, 2, opGreater, 100, rows)

' 列名指定
cnt = Where(vData, "Price", opGreater, 100, rows)

• Whereは件数を返します。0 はゼロ件、-1 はエラーです。
• 結果は引数の result （例では rows ）に参照渡しで返します。ゼロ件の時は初期化解除された状態です。

PickRowsとの組み合わせ例

Dim rows() As Long
Dim cnt As Long

cnt = Where(vData, "Price", opGreater, 100, rows)

If cnt > 0 Then
    result = PickRows(vData, rows)
End If

カスタマイズ例

• 比較演算子に opNull、opNotNull などの追加
• エラー処理（-1 を返す箇所（※））を Err.Raise などに修正（設計方針に応じて）

次回

次回は、Whereと連携して行番号でデータを抽出する PickRows を実装していきます。