VBA クラスモジュールでフィールド数の多いデータを扱う

最近読者になったブログにこんなお悩みが。

80以上の要素を持つ４００～５００件のデータをどう扱おうか悩み中。
Powerpoint VBAに触れてみて - chemiphys’s blog

自分ならどうするってのを考えてみたので公開。
やはり人のブログを読むと刺激されて執筆が捗る。

さて今回はサンプルとしておなじみの「なんちゃって個人情報」を使う。
※ダミーデータだが読者に偶然同姓同名がいても気が悪いと思うのでちっちゃく表示。
f:id:t-hom:20170103223309p:plain

さて、フィールド数が多い場合、確かにプロパティの準備が面倒くさい。たとえパブリック変数で済ませるにしても80フィールド(つまり80列)となるとさすがにやりすぎな感じ。※今回のデータはサンプルなので14列。

そこで、多数のフィールドの中でも、比較や検索などでよく利用しそうなものだけプロパティを用意し、あとは配列で済ませてしまうということを考えた。

ためしに名前と年齢だけプロパティ化してみる。
クラスモジュールを挿入し、オブジェクト名をPersonに変更して次のコードを張り付ける。

Private Parameter(1 To 14)
Property Get 名前() As String
    名前 = Parameter(1)
End Property
Property Get 年齢() As Long
    年齢 = Parameter(5)
End Property
Property Get Self() As Object
    Set Self = Me
End Property

Sub LetParameter(paramNo, value)
    Parameter(paramNo) = value
End Sub

Function GetParameter(paramNo) As Variant
    GetParameter = Parameter(paramNo)
End Function

なお、配列はオブジェクトのPublic要素にできないので、Private変数として保持させ、アクセサ(LetParameter、GetParameter)で値の設定・取得を行う。
ここでProperty構文を使わなかったのは、LetParameterが2つの引数をとるためだ。~~Property Letは引数1つまでしか想定されていないので今回のケースでは使えない。~~
↓Propertyが複数の引数をとれないというのは私の勘違いでした。
thom.hateblo.jp
この記事中のコードは変更しませんが、Property構文を使うとあたかも内部配列に直接アクセスしているかのように扱えるので、上記記事も合わせてお読みください。

さて、入れ物が完成したところで、まずは材料の取得から。

以下の関数を作成し、データを二次元配列で取得できるようにする。

Function GetDataAsArray() As Variant
    GetDataAsArray = Sheets(1).Range("A1").CurrentRegion.value
End Function

Excelはセルへのアクセスが遅いので、一旦配列化しておくとその後の加工は高速に行える。

次に、データをコレクションとして取得できる関数を用意。

Function GetDataAsCollection() As Collection
    Dim arr: arr = GetDataAsArray
    Dim C As Collection: Set C = New Collection
    Dim i, j
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        With New Person
            For j = 1 To 14
                .LetParameter j, arr(i, j)
            Next
            C.Add .Self
        End With
    Next
    Set GetDataAsCollection = C
End Function

この関数は先ほど作成したGetDataAsArrayからデータを読み取り、Personオブジェクトに格納してCollectionに追加する。

最後にメインモジュール。

Sub Main()
    Dim C As Collection: Set C = GetDataAsCollection
    Dim p As Person
    For Each p In C
        If p.年齢 < 30 _
            And p.GetParameter(4) = "女" _
            And p.GetParameter(7) = "未婚" Then
                Debug.Print p.名前
        End If
    Next
End Sub

コレクションをFor EachでまわしながらPersonデータを取出し、30歳未満の未婚の女性を抽出して名前を表示させている。

おっと、ここで4とか7ってのは俗にいうマジックナンバーってやつだ。
放っておくと何のことかわからなくなるので、列挙型定数で定義してやる。

Enum Param
    性別 = 4
    婚姻 = 7
End Enum

すると、メインコードは以下のようになる。

Sub Main()
    Dim C As Collection: Set C = GetDataAsCollection
    Dim p As Person
    For Each p In C
        If p.年齢 < 30 _
            And p.GetParameter(Param.性別) = "女" _
            And p.GetParameter(Param.婚姻) = "未婚" Then
                Debug.Print p.名前
        End If
    Next
End Sub

コーディング中も、「Param.」と入力すると候補が出るので便利。

さて、今回作ったコードを応用して、元データから条件にあった行の必要な列だけを抜き出してみよう。
コードは以下のとおり。

Sub Main2()
    Dim C As Collection: Set C = GetDataAsCollection
    Dim p As Person
    
    Dim C2 As Collection: Set C2 = New Collection
    'このループでCをフィルタリングしてC2へ入れる
    For Each p In C
        If p.年齢 < 30 _
            And p.GetParameter(Param.性別) = "女" _
            And p.GetParameter(Param.婚姻) = "未婚" Then
            C2.Add p
        End If
    Next
    
    Dim RangeArray(): ReDim RangeArray(1 To C2.Count, 1 To 5)
    Dim n As Long: n = 1
    'このループでフィールドを絞りながらシート書き込み用の配列作成
    For Each p In C2
        RangeArray(n, 1) = p.名前
        RangeArray(n, 2) = p.GetParameter(2)    '面倒なので、
        RangeArray(n, 3) = p.GetParameter(11)  'マジックナンバー
        RangeArray(n, 4) = p.GetParameter(9)    '書いちゃいます。
        RangeArray(n, 5) = p.GetParameter(3)    'ごめん！
        n = n + 1
    Next

    'シート2に配列を転記
    Sheets(2).Range("A2").Resize(C2.Count, 5).value = RangeArray
End Sub