[ExcelVBA] 構造体+コレクションで、プロパティを動的に指定して計算する方法を考える

[ExcelVBA] 構造体+コレクションで、プロパティを動的に指定して計算する方法を考える

クラスモジュールを使って、構造体とコレクションを組み合わせることで、DBのレコードのような形のデータが扱えるという記事を前に書いたんですが、特定のプロパティを選んで平均値算出をスマートに書くには、という質問をいただきました。


背景

こちらの記事のコメントにいただいた質問です。

冒頭の図のようなデータがあるとして、オブジェクト.平均値(プロパティ, 抽出条件)のように書けないか？　とのことで。おもしろそうだなと思って考えてみました。

クラスを作成

まずはコレクションに構造体を持たせるためのクラス。前の記事と同じような感じです。オブジェクト名はデフォルトのClass1からListDetailに変更してください。

'### ListDetail / 詳細クラス ###

Public Index As Long 'インデックス
Public Value1 As Long '値1
Public Value2 As Long '値2

Property Get Self() As ListDetail
  Set Self = Me
End Property

とりあえずプロパティは3つ。必要かはおいといてインデックスと、値が2種類という想定で。

ListDetail クラスだけではコレクション自体をどうこうすることができないので、もう1つクラスモジュールを追加します。

2017/12/18追記

できました(;´Д`)　クラス1つでもできることを後から気がついたので、記事の最後に追記してあります。まずはクラスを2つ使う方法を解説しています。

'### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average() As Double 'コレクションをループさせて平均値を返す関数
  '中身はあとで
End Function

こんな感じにしておくと、こちらのクラスでインスタンス化したオブジェクトに、さっきのListDetailで作ったコレクションを持たせてオブジェクト.Averageと書けば平均値が返ってくる、という想定です。

標準モジュールから構造体コレクションを作成

今度は標準モジュールから、さきほど作った2つのクラスを使ってコレクションを作ります。

'### 標準モジュール ###

Sub sample()
  '計算クラスでコレクションを生成
  Dim items As New ListCalculation
  Set items.List = New Collection
  
  '詳細クラスでコレクションの中身を作る
  Dim i As Integer
  For i = 1 To 100
    With New ListDetail
      .Index = i 'インデックス
      .Value1 = Int(100 * Rnd) '値1/0～99までのランダムな整数
      .Value2 = Int(100 * Rnd) '値2
      items.List.Add .Self 'コレクションに追加
    End With
  Next i
  
  '計算クラスの関数で平均を出す
  Debug.Print items.Average
End Sub

まずは5～6行目、ListCalculationクラスでitemsというインスタンスを作成して、items.Listコレクションを作っておきます。

で、9～17行目、ListDetailクラスを使ってコレクションの中身を埋めていきます。上記コードでは、Value1, Value2 ともに、0～99までのランダムな整数を100個設定しているので、ここはお好みで変更してください。

なお、冒頭で紹介した元記事には、CSVファイルからコレクションに追加する方法があるので必要であればそちらもご参照ください。

最後がメインの20行目、コレクションに格納した値の平均値を取得する部分になっています。

平均値を返す関数を書く

では、さきほどListCalculationクラスに作った、平均値を計算するAverage関数の中身を書きましょう。

Value1プロパティ限定

とりあえず、決め打ちのプロパティで書いてみます。

'### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average() As Double
  Dim total As Long '計算用

  '詳細クラスを使ってコレクションをループ
  Dim item As ListDetail
  For Each item In List
    total = total + item.Value1 'Value1の値を足していく
  Next

  Average = total / List.Count '要素数で割って平均値にする
End Function

コレクション内のValue1プロパティを全部足して、最後にコレクションの要素数で割って、平均を算出しています。これで、標準モジュールのプロシージャを走らせれば、Value1プロパティの平均値がイミディエイトウィンドウに出力されます。

プロパティを動的に指定

さて、やりたいことは、「指定したプロパティの」平均がほしいので、決め打ちではちょっとな…、という感じです。

'### 標準モジュール ###

Sub sample()
  '計算クラスでコレクションを生成
  '略
  
  '詳細クラスでコレクションの中身を作る
  '略
  
  '計算クラスの関数で平均を出す
  Debug.Print items.Average("Value1")
End Sub

標準モジュールの、最後の平均値を取得する部分で、引数としてプロパティ名を指定できるようにします。コレに合わせて、ListCalculationクラスのAverage関数の中身も修正します。

さて、「プロパティを変数で指定する」…、だと…？　なにか記憶にひっかかるものが…。。

……。

あっ、CallByNameだー！！！

ちょっと前に別件で「プロパティを変数で」という壁にぶつかってtwitterでぼやいてたら、thom神が教えてくれたヤツだー！！　これ進研ゼミで見たヤツだわー！！！

結局そのときのコードは、そもそもの設計がうまくなくてお蔵入りになっちゃったので、とてもテンションがあがりました（どうでもいい余談）。

'### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average(ByVal propName As String) As Double
  Dim total As Long '計算用

  '詳細クラスを使ってコレクションをループ
  Dim item As ListDetail
  For Each item In List
    total = total + CallByName(item, propName, VbGet) '指定プロパティの値を足していく
  Next

  Average = total / List.Count '要素数で割って平均値にする
End Function

5行目でプロパティ名を文字列型の変数で受け取って、11行目のCallByNameで、オブジェクト、プロパティ、種類の順で指定します。種類をvbMethodにすれば、プロシージャを文字列型で指定することもできるんだとか。おおー。

条件を設定する

さらに、コレクションの中で条件に一致した要素のみ処理を行う、という件も考えてみます。

パターンを指定する

どんな条件がサンプルとしてわかりやすいものかちょっとアレなんですが…、

'### 標準モジュール ###

Sub sample()
  '計算クラスでコレクションを生成
  '略
  
  '詳細クラスでコレクションの中身を作る
  '略
  
  '計算クラスの関数で平均を出す
  Debug.Print items.Average("Value1", "ptn1")
End Sub

標準モジュールから呼び出すときに、いくつかあるパターンを文字列で指定しちゃうという例。

'### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average(ByVal propName As String, Optional pattern As String = "ptn0") As Double
  Dim total As Long
  Dim n As Long 'カウント用

  '詳細クラスを使ってコレクションをループ
  Dim item As ListDetail
  For Each item In List
    '条件判定のフラグ
    Dim isMatch As Boolean: isMatch = False

    '条件に一致するか
    Select Case pattern
      Case "ptn0"
        '条件0（未記入時/デフォルト）
        isMatch = True
      Case "ptn1"
        '条件1
        If item.Index >= 5 Then isMatch = True 'Indexが5以上のものだけとか？
      Case "ptn2"
        '条件2
        '…
      Case Else
        MsgBox "存在しない条件です"
        Exit Function
    End Select

    '条件クリアしたものだけ足していく
    If isMatch = True Then
      n = n + 1 'カウントアップ
      total = total + CallByName(item, propName, VbGet) '指定プロパティの値を足していく
    End If
  Next

  'カウント数で割って平均値にする
  Average = total / n
End Function

受け取ったパターン名を見て16～29行目のSelect文で処理の可否を判定し、フラグが立ったものだけ計算していきます。

ちなみに5行目のようにOptionalをつけておくと、引数が省略されたときのデフォルト値を設定できます。この場合でitems.Average("Value1")と第二引数を省略して書くと、ptn0と判定されて全要素が対象になる、という感じですね。

指定範囲を設ける

もう1つ。Indexという要素番号プロパティを作ってあるので、それが特定の範囲内だったら、という例。

'### 標準モジュール ###

Sub sample()
  '計算クラスでコレクションを生成
  '略
  
  '詳細クラスでコレクションの中身を作る
  '略
  
  '計算クラスの関数で平均を出す
  Debug.Print items.Average("Value1", 5, 10)
End Sub

呼び出す側では、プロパティ名、Indexの開始番号、終了番号の順で指定。

'### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average(ByVal propName As String, ByVal startIdx As Long, ByVal endIdx As Long) As Double
  Dim total As Long
  Dim n As Long 'カウント用

  '詳細クラスを使ってコレクションをループ
  Dim item As ListDetail
  For Each item In List
    'Indexが指定範囲内のものだけ
    If startIdx <= item.Index And item.Index <= endIdx Then
      n = n + 1 'カウントアップ
      total = total + CallByName(item, propName, VbGet) '指定プロパティの値を足していく
    End If
  Next

  'カウント数で割って平均値にする
  Average = total / n
End Function

開始番号と終了番号を受け取って、13行目でIndexが範囲に入ってるか判定しています。この方法なら、日付型のプロパティがあれば、日付が指定範囲のものだけ計算するとか、そういうこともできそうですね。

おわりに

自分でも「わー！　こんなことできるんだー！！」とウキウキして書けて楽しかったです。ただ、ここまで勢いで書いたものの、実際コレ、スピード的にはどうなんだろう…。。大規模データでのテストはしてないので、もし実用に耐えなかったらすみません…！

まぁでも、大規模なデータを扱うなら、そもそもExcelなんだから普通にシート使ったり、外部DBのテーブルと連携させたりするほうが健全ですねw　大規模なデータからちょこっと読み込んできてコレクションに入れて処理する、くらいな使い方がいいんじゃないかと思います。

2017/12/18追記：クラス1つでも書けた

この記事を書いてからしばらくして、んんん？？　と思って試してみたらふっつーーーにクラス1つでもできました…。むしろなぜあのときできないと思ったのか思い出せない…、数ヶ月前の自分は完全に他人…。。

ただ、クラスを2つ使ってる場合は、プロパティのみの詳細クラスを束ねて計算クラスのコレクションに入れてるので無駄がないというか、構造体用のクラスと動かす用のクラスに分かれててスマートなんじゃないのか…？　という気はしています。でもクラス1つのほうが楽でいいよなぁ、だけど不必要なメソッドもコレクションに束にして突っ込んでる感じがするけど、これでいいのか？　という気がしたり…。どちらも結果は同じだし100程度のサンプルでは速さも気にならなかったので、好みの問題なのかもしれません。お作法的にはどちらのほうがよろしいのだろう…。

そのあたりのぐだぐだはともかく、クラス1つで書いたものを追記します！

'### 標準モジュール ###

Sub sample()
  'コレクション生成
  Dim items As New ListCalculation
  Set items.List = New Collection
  
  'コレクションの中身を作る
  Dim i As Integer
  For i = 1 To 100
    With New ListCalculation
      .Index = i 'インデックス
      .Value1 = Int(100 * Rnd) '値1/0～99までのランダムな整数
      .Value2 = Int(100 * Rnd) '値2
      items.List.Add .Self 'コレクションに追加
    End With
  Next i
  
  'Value1の平均を出す
  Debug.Print items.Average("Value1")
End Sub

↑こっちが標準モジュール。コレクション作って、中身を入れて、プロパティを指定して平均値を返します。

'### クラスモジュール / ListCalculation ###

Public List As Collection 'コレクション格納用
Public Index As Long 'インデックス
Public Value1 As Long '値1
Public Value2 As Long '値2

Property Get Self() As ListCalculation
  '自身を返す関数
  Set Self = Me
End Property

Function Average(ByVal propName As String) As Double
  '平均値算出関数

  '配列に追加
  Dim arr() As Double
  Dim n As Long
  Dim item As ListCalculation
  For Each item In List 'コレクションをループ
    ReDim Preserve arr(n)
    arr(n) = CallByName(item, propName, VbGet)
    n = n + 1
  Next
  
  '平均値算出
  ReDim Preserve arr(n - 1)
  Average = WorksheetFunction.Average(arr)
End Function

↑こっちがクラス。

以上です！　迷走してすみません(;´Д`)　もし「こういうのがいいよ！」っていうご意見あったらぜひお聞かせください…！

公開日：2017/10/16
更新日：2017/12/18

ExcelVBAに興味をお持ちの方は、こちらの記事もどうぞ！

書籍を執筆しています。

はてブ Pocket feedly

4件のコメント

  1. 通りすがり より:
    2017年10月16日 11:39 PM

    *youさん、

    早速のご回答ありがとうございます。
    クラスを２つ使う。こんなこともできるんですね。勉強になります！！

    さて、実際の使われ方としては、あるプロパティに対して検索条件で抽出し、それに対応する別のプロパティの演算をしたい、というのがあるので、こんな風なコードを作ってみました。

    ここで質問があります。

    オートフィルターのメソッドのように、検索条件の比較演算子 (=, <, など) を標準モジュールで記述できるような汎用性のあるコードにすることはできるのでしょうか？

    今のコードの書き方だと標準モジュールのAverageメソッドの引数を見ても、どのような検索条件なのかはクラスモジュールを見ないと分からないので、標準モジュールのメソッドの引数を見るだけで比較演算子が分かるようになれば汎用性があっていいかと思います。

    あんまり込み入った検索条件にするならそもそもオートフィルタを使ったほうが良い、と言われそうですが＾＾

    よろしくお願いします。

    Option Explicit

'### ListCalculation / 計算クラス ###
 
Public List As Collection 'コレクション格納用
 
Function Average(ByVal lookupPropName As String, ByVal searchCriteria As String, ByVal returnPropName As String) As Double

    Dim item As ListDetail
    Dim arr() As Double
    Dim n As Long

    For Each item In List
        If CStr(CallByName(item, lookupPropName, VbGet)) = searchCriteria Then
            ReDim Preserve arr(n)
            arr(n) = CallByName(item, returnPropName, VbGet)
            n = n + 1
        End If
    Next
    ReDim Preserve arr(n - 1)

    Average = WorksheetFunction.Average(arr)
End Function
    返信
    • *you より:
      2017年10月18日 12:23 PM

      こんにちは、ご要望に沿った内容になれたようで安心しました。

      > あるプロパティに対して検索条件で抽出し、それに対応する別のプロパティの演算
      これはアツイですね…！　VLookUpな使い方もできるんだと、こちらこそ勉強になります(*ﾟωﾟ*)

      さて、引数に比較演算子の件ですが、VBAのクラスでオートフィルタみたいな複雑な定義…、うーん、どこまでできるのかなー。。残念ながら現状の私の理解の範疇ではあれほど汎用的にはできなさそうだったのですが、シンプルに「=10」「<=10」「<>10」程度の、「比較演算子&数値」限定ならば、こんな感じになるかなーと、考えてみました。

      '### 標準モジュール ###

Sub sample()
  '計算クラスでコレクションを生成
  Dim items As New ListCalculation
  Set items.List = New Collection
  
  '詳細クラスでコレクションの中身を作る
  Dim i As Integer
  For i = 1 To 100
    With New ListDetail
      .Index = i 'インデックス
      .Value1 = Int(100 * Rnd) '値1/0～99までのランダムな整数
      .Value2 = Int(100 * Rnd) '値2
      items.List.Add .Self 'コレクションに追加
    End With
  Next i
  
  '計算クラスの関数で平均を出す
  Debug.Print items.Average("Value1", ">=10", "Value2")
End Sub

      条件で指定できる演算子は「<, <=, >, >=, =, <>」のみにしてあります。

      '### ListCalculation / 計算クラス ###

Public List As Collection 'コレクション格納用

Function Average(ByVal lookupPropName As String, ByVal searchCriteria As String, ByVal returnPropName As String) As Double
  '平均値算出関数

  '演算子と数値を取り出してチェック
  Dim operator As String: operator = getOperator(searchCriteria) '演算子
  Dim number As String: number = Replace(searchCriteria, operator, "") '数値
  If operator = "" Or IsNumeric(number) = False Then '式チェック
    MsgBox "条件は「<, <=, >, >=, =, <>  & 数値」 の形式で指定してください。"
    Exit Function
  End If
  
  '条件チェック & 配列に追加
  Dim item As ListDetail
  Dim lookupPropValue As Long
  Dim arr() As Double
  Dim n As Long
  For Each item In List 'コレクションをループ
    lookupPropValue = CallByName(item, lookupPropName, VbGet) '検索対象のプロパティ
    If Evaluate(lookupPropValue & operator & number) = True Then '条件に合ったら
      ReDim Preserve arr(n)
      arr(n) = CallByName(item, returnPropName, VbGet) '対応プロパティを配列に追加
      n = n + 1
    End If
  Next
  
  '存在チェック
  If n = 0 Then
    MsgBox "条件に合う要素がありません"
    Exit Function
  End If
  
  '平均値算出
  ReDim Preserve arr(n - 1)
  Average = WorksheetFunction.Average(arr)
End Function

Private Function getOperator(ByVal searchCriteria As String) As String
  '条件文から比較演算子を取り出す関数
  
  Dim operator As String
  If IsNumeric(Mid(searchCriteria, 2, 1)) = False Then '2文字目が数値じゃなければ
    operator = Left(searchCriteria, 2) '左から2文字
  Else
    operator = Left(searchCriteria, 1) '左から1文字
  End If
  
  If operator = "<" Or operator = "<=" Or _
     operator = ">" Or operator = ">=" Or _
     operator = "=" Or operator = "<>" Then
       getOperator = operator
  Else
    getOperator = "" '上記以外のものだったら空白を返しておく
  End If
End Function

      コード拝見して、アッそうか平均って WorksheetFunction.Average でいいんだ…！　と思ったので倣わせていただきました。演算子だけ取り出すのに、チェックがてらもう1つ関数を使っています。いろいろ自己流なので、もっとスマートな方法があるかもしれませんすみません…_(:3 」∠)_

      私も今回初めて知ったんですが、23行目のEvaluateという関数が便利すぎてびっくりしました。

      こんな感じでいかがでしょうか。

  2. 通りすがり より:
    2017年10月31日 12:40 PM

    *youさん、

    すっかり返事が遅くなりすみません。ここ最近ずっとチェックできていませんでした。

    Evaluate(lookupPropValue & operator & number)
    こんなのができるんですね!! すごいです。

    これでやりたいことはできたので、解決とさせていただきます。

    ありがとうございました。

    返信
    • *you より:
      2017年12月18日 12:12 PM

      もう見ていらっしゃらないと思うのですが一応…、クラス2つ使った方法で解説させていただいてしまったのですが、クラス1つでもできることに後から気づいたので本文追記しておきました。いつか気がついたときにはご容赦ください_(:3 」∠)_


コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。

コメントは承認制ですので、反映までしばらくお待ち下さい。（稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。）

YouTubeでQ&Aコンテンツを企画しています

運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。