社名をキーに、各商品の合計額を求めるアレコレ

コロ子さんのブログに書き込みしたところ、過去記事を紹介していただいた。
koroko.hatenablog.com

念のため、おさらい。
↓のような表に於いて、社名ごとに商品の合計額を知りたい。

私の過去記事では、

1. 辞書に、全商品の金額を格納した配列をセットするパターン
2. 辞書を配列にして、商品毎に金額をセットするパターン

を紹介しているが、コロ子さんのブログでは、後者が採用されていた。

そこで今回こちらでは、辞書に配列を格納するパターンをやってみようと思う。
まず、項目名で列挙体を作成する。

Enum 項目名
    en社名 = 1
    en商品A
    en商品B
    en商品C
End Enum

次に、社名ごとに表をスライスし、行を抜き取る。

Property Get Dict() As Object
    Dim tempDict As Object
    Set tempDict = CreateObject("Scripting.Dictionary")
    Dim SourceArray As Variant
        SourceArray = Range("A1:D5")
    Dim i As Long
        For i = 2 To UBound(SourceArray)
            tempDict(SourceArray(i, 項目名.en社名)) = _
                WorksheetFunction.Index(SourceArray, i, 0)
        Next
    Set Dict = tempDict
End Property

これで、準備完了だ。それでは、Ａ社の商品Ａ～Ｃの合計を求めてみよう。

Sub test()
    Dim 価格 As Object
    Set 価格 = Dict
        
        Debug.Print 価格("Ａ社")(en商品A) + _
                    価格("Ａ社")(en商品B) + _
                    価格("Ａ社")(en商品C)
    
End Sub

結果は、以下のとおり。

ちなみに、毎回必ずＡ～Ｃすべてを合計するなら、話はもっと早くなる。
単純に、SUM関数で足してあげればよいわけで。
※文字列である社名は足し算に於いて無視される。

Sub test2()
    Debug.Print WorksheetFunction.Sum(Dict("Ａ社"))
End Sub

そしておそらく、私が思いつけていないだけで、世の中にはもっと良い方法が、
きっとあるに違いない。どの方式を採用するかは、時と場合と各位のお好みで。

参考まで。