【Excel VBA】Scripting.Dictionaryを使った統計情報集計

「Statistics.zip」をダウンロード

Scripting.Dictionaryを使った統計情報集計マクロ、連想配列の仕組みは、そのまま統計先仕訳用のラベルとして使っている。

もっと他にもよい使い方がありそう。

必要なインプット情報

・集計ルールとして、集計ラベル（キーワード）と集約先（サマリキーワード）

アウトプット

・　集計ラベル（キーワード）毎の統計数

・　集約先（サマリキーワード）毎のサマリ統計数

内部仕様として、

①集計値には、統計の素要素となる情報の他にサマリ（集約情報）を付加してあり、キーワード集計の他に集約結果（サマリ集計）も可能にしてある。

②集計元の行が連続データでない（空白等）場合については、単純に読み飛ばすのではなく前回使った集計ラベル（キーワード）に集計することとしている。

核となるソース（CStatistics.cls）

‘事前にVBエディタの[ツール(T)]->[参照設定(R)]から[Microsoft Scripting Runtime]のチェック欄にチェックを入れておくこと
Private m_StatisticsTable As Scripting.Dictionary ‘集計用テーブル
Private m_LastKeyWord As String

Private Sub Class_Initialize()
Set m_StatisticsTable = New Scripting.Dictionary
m_LastKeyWord = ""
End Sub

‘ルールを設定
Public Sub SetClassifyRule(ByVal KeyWord As String, ByVal SummaryKeyWord As String, Optional IsDefaultKeyWord As Boolean)
    Dim Data As New CClassifiedData
    Data.Count = 0
    Data.Name = KeyWord
    Data.SummaryName = SummaryKeyWord
   
    If IsDefaultKeyWord = True Then
        ‘初期キーワードとする。
        m_LastKeyWord = KeyWord
    End If
   
    Call m_StatisticsTable.Add(KeyWord, Data)
End Sub

‘統計処理
Public Sub SetStatistics(ByVal KeyWord As String, ByVal Count As Integer)
    Dim Data As CClassifiedData
    If m_StatisticsTable.Exists(KeyWord) = True Then ‘キーワードが存在するか
             Set Data = m_StatisticsTable.item(KeyWord)
             Data.Count = Data.Count + Count
            
            If m_LastKeyWord <> KeyWord Then
                m_LastKeyWord = KeyWord
            End If
    Else    ‘キーワードが存在しない場合、前回のキーワードに集計
            Set Data = m_StatisticsTable.item(m_LastKeyWord)
            Data.Count = Data.Count + Count
    End If
End Sub

‘結果を取得
Public Function GetStatistics(ByVal KeyWord As String) As Long
    Dim result As Integer: result = 0
    Dim Data As CClassifiedData
    If m_StatisticsTable.Exists(KeyWord) = True Then
        Set Data = m_StatisticsTable.item(KeyWord)
        result = Data.Count
    End If
    GetStatistics = result
End Function

‘結果を取得（サマリ）
Public Function GetStatisticsOfSummary(ByVal SummaryKeyWord As String) As Long
    Dim result As Integer:   result = 0
    Dim Data As CClassifiedData
   
    If SummaryKeyWord <> "" Then
        Dim data2 As Variant ‘voidポインタのようなもの
        For Each data2 In m_StatisticsTable.Items
            Set Data = data2 ‘中身は登録したCClassifiedDataなのでキャスト
            If Data.SummaryName = SummaryKeyWord Then
                result = result + Data.Count
            End If
        Next
    End If
    GetStatisticsOfSummary = result
End Function

Sub ClearCount()
    Dim Data As CClassifiedData
    Dim data2 As Variant ‘voidポインタのようなもの
    For Each data2 In m_StatisticsTable.Items
        Set Data = data2 ‘中身は登録したCClassifiedDataなのでキャスト
        Data.Count = 0
    Next
End Sub

Sub DebugPrint(Optional KeyWord As String = "")
    Dim Data As CClassifiedData
   
    If KeyWord = "" Then
        Dim data2 As Variant ‘voidポインタのようなもの
        For Each data2 In m_StatisticsTable.Items
            Set Data = data2 ‘中身は登録したデータなのでキャスト
            Data.DebugPrint
        Next
    Else
        Set Data = m_StatisticsTable(KeyWord)
            Data.DebugPrint
    End If
End Sub

核となるソース（CClassifiedData.cls）

Public Name As String
Public Count As Integer
Public SummaryName As String

Private Sub Class_Initialize()
    Me.Count = 0
    Me.Name = ""
    Me.SummaryName = 0
End Sub

Public Function GetMyself() As CClassifiedData
    Set GetMe = Me
End Function

Public Sub DebugPrint()
    Debug.Print "SummaryName="; Me.SummaryName
    Debug.Print "Name=" & Me.Name
    Debug.Print "Count=" & Me.Count
End Sub