可変になる出力範囲を指定して計算を実行したい

Question

現在、商品コードを入れると、マスタから対応するオプション料金を取得する処理を作成しています。
その中で、出力範囲が可変になる場合を考慮した処理をどうすればいいのか悩んでおります。

• マスタシート

事前に、一意の商品コードに紐づく対象項目、オプション料金、オプションコード、オプション名称が登録されている。
対象項目1、オプション料金1、オプションコード1、オプション名称1は必須だが、2以降は任意。
また、J列の横に対象項目3、オプション料金3、オプションコード3、オプション名称3...と後から項目が増える可能性がある。

• 商品シート

手動で、商品コード、数量、重さ、金額を入力する。一意の商品コードに対して数量、重さ、金額すべて登録されている。
商品コードが重複して登録されることはない。桁数は最大桁４桁。
マスタシートで項目が増えた場合、K列の横に総計3,コード3,料金名3...と増える可能性がある。

処理の流れは以下になります。

1. 商品シートに商品コード、数量、重さ、金額を入力
2. 計算ボタンを押下すると、

商品シートの商品コード１列目から順に
マスタシートの商品項目に紐づく料金コード * 商品シートの数量、重さ、金額(いずれか）
を計算し、総計欄に出力。
計算に利用したマスタシートのオプションコードと名称も出力する。
商品シートのデータがある最後尾まで処理を実施すると、処理完了となる。

そこで以下のような処理を考えたのですが、
マスタシートの対象項目、オプション料金、オプションコード、オプション名称が後から増える可能性がある点が上手く考慮できていません。
SetOtherObjectファンクションで、対象項目の列によって検索範囲の列名を配列に設定してSetValueで計算時に配列から列番号を取り出す処理を考えていますが、SetOtherObjectファンクションで分岐するときマスタのC列かG列かという判定にしているので今後増えた場合、更に分岐を増やす...ということになって冗長化して良くないと思っています。
検索範囲をdictionaryに入れたらいいのかとも思ったのですが、いい設定方法が思いつきませんでした。。。
可変の検索範囲の設定方法についていい案があったらご教授お願い致します。
また、説明不足な点がありましたらご指摘ください。

Public mash As Worksheet
Public pdsh As Worksheet
Public maxrow1 As Long
Public maxrow2 As Long
Public i As Long
Public ma As Object
Public masKey As String

Sub CalculatePrice()
    Dim tmpcd1 As String
    Dim tmpcd2 As String
    Dim tmp1(6) As String
    Dim tmp2 As Variant

    Set ma = CreateObject("Scripting.Dictionary")
    Set mash = Sheets("マスタ")
    Set pdsh = Sheets("商品")

   maxrow1 = mash.Cells(Rows.Count, "B").End(xlUp).Row
    
  For row1 = 3 To maxrow1
    masKey = mash.Cells(row1, "B").Value
    ma(masKey) = row1
  Next

  maxrow1 = pdsh.Cells(Rows.Count, "B").End(xlUp).Row

  For i = 3 To maxrow1
    masKey = pdsh.Cells(i, "B")
    row1 = ma(masKey)
    
    tmpcd1 = mash.Cells(row1, "C").Value
    tmp2 = SetOtherObject(tmp1, "C", tmpcd1)
    Call SetValue(row1, i, tmp1)
    
    tmpcd1 = mash.Cells(row1, "G").Value
    
    If tmpcd1 <> "" Then
      tmp2 = SetOtherObject(tmp1, "G", tmpcd1)
      Call SetValue(row1, i, tmp1)
    End If
    Next
End Sub

Function SetOtherObject(ByRef arry() As String, o As String, calitm As String) As Variant
    
    If o = "C" Then
        arry(1) = "D"
        arry(2) = "E"
        arry(3) = "F"
        arry(4) = "G"
        arry(5) = "H"
        
        Select Case calitm
        
        Case "金額"
          arry(0) = "E"
        Case "数量"
          arry(0) = "D"
        Case "重さ"
          arry(0) = "C"
        End Select
    Else
        arry(1) = "H"
        arry(2) = "I"
        arry(3) = "I"
        arry(4) = "J"
        arry(5) = "K"
        
        Select Case calitem
        
        Case "金額"
          arry(0) = "E"
        Case "数量"
          arry(0) = "D"
        Case "重さ"
          arry(0) = "C"
        End Select
    End If
    SetOtherObject = arry
 
End Function

Sub SetValue(row1, i, tmp)
    Dim x As Long, y As Long, z As Long   
    x = pdsh.Cells(i, tmp(0)).Value
    y = mash.Cells(row1, tmp(1))
    
    pdsh.Cells(i, tmp(3)).Value = x * y
    pdsh.Cells(i, tmp(4)) = mash.Cells(row1, tmp(2)).Value
    pdsh.Cells(i, tmp(5)) = mash.Cells(row1, tmp(3)).Value
End Sub

Answer 1

オプションは金額、数量、重さのみの前提です。
オプションが増えた場合でも、ループの上限を変えれば良いだけなので、修正は容易かと。
（商品シートはレイアウトの変更が必要になりますので、その箇所はマクロも修正が必要です。）

Option Explicit
Public mash As Worksheet
Public pdsh As Worksheet
Public ma_cd As Object      'キー：商品コード　値：マスタシートの行番号
Public ma_opt As Object     'キー：商品コード　値：出現したオプション（複数あり）カンマで区切る
Public kind_opt As Object   'キー：オプション（金額、数量、重さ等）　値：商品シートの列番号


Public Sub オプション集計()
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim col1 As Long
    Dim col2 As Long
    Dim Key As String
    Dim Key2 As String
    Dim i As Long
    Dim options As Variant
    Set ma_cd = CreateObject("Scripting.Dictionary")
    Set ma_opt = CreateObject("Scripting.Dictionary")
    Set kind_opt = CreateObject("Scripting.Dictionary")
    Set mash = Sheets("マスタ")
    Set pdsh = Sheets("商品")
    '各オプションの列番号を記憶する
    For col2 = 3 To 5
        Key = pdsh.Cells(2, col2).Value
        kind_opt(Key) = col2
    Next
    maxrow1 = mash.Cells(Rows.Count, "B").End(xlUp).Row
    'マスタシートの行番号とオプションの種類を記憶する
    For row1 = 3 To maxrow1
        Key = mash.Cells(row1, "B").Value
        ma_cd(Key) = row1
        'K列までオプションを記憶する
        For col1 = 3 To 11 Step 4
            Key2 = mash.Cells(row1, col1).Value
            If Key2 = "" Then Exit For
            If kind_opt.exists(Key2) = True Then
                If ma_opt.exists(Key) = False Then
                    ma_opt(Key) = Key2
                Else
                    ma_opt(Key) = ma_opt(Key) & "," & Key2
                End If
            Else
                MsgBox (row1 & "行 " & col1 & "列の" & Key2 & "は商品シートに未登録です")
                Exit Sub
            End If
        Next
    Next
    
    maxrow2 = pdsh.Cells(Rows.Count, "B").End(xlUp).Row
    '商品シートを全行分処理する
    For row2 = 3 To maxrow2
        'F列～N列をクリア
        pdsh.Range("F" & row2 & ":N" & row2).Value = ""
        Key = pdsh.Cells(row2, "B").Value
        row1 = ma_cd(Key)
        options = Split(ma_opt(Key), ",")
        For i = 0 To UBound(options)
            col1 = 3 + i * 4
            col2 = kind_opt(options(i))
            pdsh.Cells(row2, 6 + i * 3).Value = pdsh.Cells(row2, col2).Value * mash.Cells(row1, col1 + 1).Value 'オプション料総計
            pdsh.Cells(row2, 7 + i * 3).Value = mash.Cells(row1, col1 + 2).Value 'オプションコード
            pdsh.Cells(row2, 8 + i * 3).Value = mash.Cells(row1, col1 + 3).Value 'オプション名
        Next
    Next
    
End Sub

Comments

[退会済みユーザー]

ご回答ありがとうございます！
ループの回し方が考えつかなかったので非常に助かりました。
このあと、教えて頂きましたコードを自分で動かして確認してみます。

Answer 2

こういった「後からデーターベースに大きな変更がある設計」という設計自体が間違っています。
最大100個としてオプション料金欄を作っておき、
縦に検索の後、横にループ処理してあるかぎりのオプション料金を抽出するのが良いでしょう。
全抽出後に出力しているページの罫線や色付けを調整するようにすればよいかと思います。

どうしても「追加前提」で設計したい場合は品番・オプションのテーブル（シート）を別で作り、
そちらから抽出すればよいかと思います。
（メンテナンスが大変なので追加・削除用のUIを作れば良いと思います）

Comments

[退会済みユーザー]

ご回答ありがとうございます！
なるほど、最初から固定で追加分を固定するんですね。
流石に100までふえることはなさそうなので、10位で想定してコードに修正してみようと思います！

[shinobu_osaka]

まさかの追加でも超えないようにしておかないと、いざ超えたときがすごく面倒ですよ、多めにしておくのが良いと思います。

Answer 3

すみません。
商品シートの商品CD＝101,数量=5,重さ=8,金額=200の時
計算結果はどのようになるのですか。
オプション料１総計
対象オプションCD1
対象オプション名１
オプション料２総計
対象オプションCD２
対象オプション名２
に設定される値と、その計算方法を具体的に提示していただけませんでしょうか。

Comments

[退会済みユーザー]

オプション料1総計50×200=1000
※
・マスタシートの商品コード101のオプション1→対象項目が金額,オプション料金が200
・商品シートに入力された金額→50

対象オプションCD1 400
対象オプション名1 サービス料①
オプション料2総額　50×8=400
※
・マスタシートの商品コード101のオプション2→対象項目が数量,オプション料金2が50
商品シートに入力された数量→8

対象オプションCD2 200
対象オプション名2 加工②

になります！
他に不明点あればご指摘下さい。

[tatsu99]

１）オプション料1総計50×200=1000ですが、これは
商品コード＝１０１の金額のオプション料金が５０、商品シートの金額が２００なので、５０×２００であってますか。
２）オプション料2総額　50×8=400　これがよくわかりません。
商品コード＝１０１の数量のオプション料金が５０なので５０、商品シートの数量は５なので
５０×５＝２５０ではないでしょうか。なぜ、重さの８を掛けるのかが判りません。
３）マスタのシートはK列以降に追加の予定があるとのことですが、商品シートのオプションは数量、重さ、金額となっています。つまり、最大３種類ということであってますか。もし、数量、重さ、金額の他に何か別のオプションも追加になる可能性があるのですか。もし、そうなった場合は、商品シートのE列の次にその追加オプションを割り込ませることになるのでしょうか。つまり、商品シートのレイアウトの変更が発生することになるのでしょうか。

[退会済みユーザー]

回答が遅くなり申し訳ございません。
１）仰る認識であっています。
２）すみません、打ち間違いでした。ご指摘のとおり数量を使うので5×50になります。
3）現状、金額、重さ、数量のみになります。　他の項目の追加はしないため、項目追加によるレイアウト変更はありません。