行列の交差する値をＶＢＡで取得する、の別解①

こちら ↓ にて、INDEX関数とMATCH関数の組合せをVBAでやった場合について紹介されていた。
note.mu
これについてコメントを募集されていたので、私も挑戦してみた。

条件をおさらいすると、まず ↓ このような料金表がある。

当該表において、以下の４条件を指定した時、これに一致する金額を求めたい。

リンク先の記事では、シート上で値が変わるごとに For ～ Next でループさせ、
目的の値と一致したらループを抜けるという手法を採用している。個人的には、
ストーリーが分かり易いため、充分に用をなしていると思う。

そこで今回は別解として、最初に値を全て取得しておく、という方法を考えて
みた。４つの条件を結合し、これをキーとする連想配列を作成する。例えば、
　Ａ支店商品Ａ2018年プラン１　⇒　1000
のような感じだ。

※どちらが良いということではなく、あくまで参考の別解ということで。

連想配列のために、事前に「Microsift Scripting Runtime」を参照設定しておく。

標準モジュール

Option Explicit

Dim Dict As Dictionary

' 価格表用の辞書（連想配列）
Private Property Get PlanDict() As Dictionary
    Dim tempDict As Dictionary
    Set tempDict = New Dictionary
    
    Dim r As Range
    Dim myKey As String
    Dim seq(3) As Variant
        ' 各値段に関する４つの条件を、一旦配列に格納する。
        For Each r In Range(Cells(4, 4), Cells(11, 11))
            seq(0) = Cells(r.Row, 2)
            seq(1) = Cells(r.Row, 3)
            seq(2) = Cells(2, r.Column)
            seq(3) = Cells(3, r.Column)
            
            ' 配列内の文字を結合し、辞書用のキーとする。
            myKey = Join(seq, vbNullString)
            
            ' キーに対し、値段をアイテムとして登録する。
            tempDict(myKey) = r.Value
        Next
        Set PlanDict = tempDict
End Property

' 価格取得用ユーザー定義関数
Public Function 料金(支店 As String, 商品 As String, 年度 As String, プラン As String) As Variant
    If Dict Is Nothing Then
        Set Dict = PlanDict
    End If
    
    Dim myKey As String
        myKey = 支店 & 商品 & 年度 & プラン
        If Dict.Exists(myKey) Then
            料金 = Dict(myKey)
        Else
            料金 = "指定エラー"
        End If
End Function

結果がこちら。

なお、今回は条件が４つだったので、さほど手間ではなかった。しかしもっと沢山の条件が登場するような場合は、↓ こちらの方法を検討するのも良いと思う。
thom.hateblo.jp

参考まで。