VBA Scripting.Dictionary 連想配列 複数参照する方法

以下のコードは以前質問させていただいたものになります
https://oshiete.goo.ne.jp/qa/12707381.html

以下要約
AブックのC列に果物名前(果物名に重複無し)
Bブックの各シートC列に果物名前(ブック上果物名に重複無し)、D列に値段が記載

AブックのD列にBブックの該当する果物値段を貼り付け
検索で引っかかった場合その果物は検索を止め、該当しなかった果物は該当なし記載となる

Aブックの特定セル2箇所(F2,G2)に50や100と入力すると
Bブックのシート50～100を参照しにいきます

質問
Bブックの各シートI列に生産国、K列にコメントが記載されており、
AブックのH列に生産国、J列にコメントを反映させ、
該当しなかったセルには同様に該当なし記載となるよう以下のコードに追加できますでしょうか

よろしくお願いいたします。


Option Explicit
Public Sub 値段設定()
Dim dicT As Object
Dim ws As Worksheet
Dim ts As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim st_no As Long
Dim en_no As Long
Dim sheet_no As Long
Dim max_sheet_no As Long
Dim err As Boolean
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
max_sheet_no = Workbooks("B.xlsx").Worksheets.count
Set ws = ActiveSheet
st_no = ws.Range("F2").Value
en_no = ws.Range("G2").Value
If st_no < 1 Or st_no > max_sheet_no Then err = True
If en_no < 1 Or en_no > max_sheet_no Then err = True
If st_no > en_no Then err = True
If err = True Then
MsgBox ("開始番号または終了番号が誤っています")
Exit Sub
End If
For sheet_no = st_no To en_no
Set ts = Workbooks("B.xlsx").Worksheets(sheet_no)
maxrow = ts.Cells(Rows.count, "C").End(xlUp).Row
For wrow = 5 To maxrow
dicT(ts.Cells(wrow, "C").Value) = ts.Cells(wrow, "D").Value
Next
Next
maxrow = ws.Cells(Rows.count, "C").End(xlUp).Row
For wrow = 3 To maxrow
If dicT.exists(ws.Cells(wrow, "C").Value) = True Then
ws.Cells(wrow, "D").Value = dicT(ws.Cells(wrow, "C").Value)
Else
ws.Cells(wrow, "D").Value = "該当なし"
End If
Next
MsgBox ("完了")
End Sub

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/12/17 10:23

前回回答者です。

#1様のアドバイスに従い、改造してみました。
又、エラーメッセージに最大終了番号を表示するように修正しました。

Option Explicit
Public Sub 値段設定()
Dim dicT As Object
Dim ws As Worksheet
Dim ts As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim st_no As Long
Dim en_no As Long
Dim sheet_no As Long
Dim max_sheet_no As Long
Dim err As Boolean
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
max_sheet_no = Workbooks("B.xlsx").Worksheets.count
Set ws = ActiveSheet
st_no = ws.Range("F2").Value
en_no = ws.Range("G2").Value
If st_no < 1 Or st_no > max_sheet_no Then err = True
If en_no < 1 Or en_no > max_sheet_no Then err = True
If st_no > en_no Then err = True
If err = True Then
MsgBox ("開始番号または終了番号が誤っています。最大終了番号=" & max_sheet_no)
Exit Sub
End If
For sheet_no = st_no To en_no
Set ts = Workbooks("B.xlsx").Worksheets(sheet_no)
maxrow = ts.Cells(Rows.count, "C").End(xlUp).Row
For wrow = 5 To maxrow
dicT(ts.Cells(wrow, "C").Value) = Array(ts.Cells(wrow, "D").Value, ts.Cells(wrow, "I").Value, ts.Cells(wrow, "K").Value)
Next
Next
maxrow = ws.Cells(Rows.count, "C").End(xlUp).Row
For wrow = 3 To maxrow
If dicT.exists(ws.Cells(wrow, "C").Value) = True Then
ws.Cells(wrow, "D").Value = dicT(ws.Cells(wrow, "C").Value)(0)
ws.Cells(wrow, "H").Value = dicT(ws.Cells(wrow, "C").Value)(1)
ws.Cells(wrow, "J").Value = dicT(ws.Cells(wrow, "C").Value)(2)
Else
ws.Cells(wrow, "D").Value = "該当なし"
End If
Next
MsgBox ("完了")
End Sub

この回答へのお礼

tatsumaru77様
この度もありがとうございます。
希望通り動作することができました！

めぐみん_様もありがとうございます。

お礼日時：2021/12/17 19:59

No.1 回答者： めぐみん_ 回答日時： 2021/12/17 08:45

直接の回答ではないですが、

＞VBA Scripting.Dictionary 連想配列 複数参照する方法

としてはItem側を配列にすれば宜しいのでは？

Dictionaryオブジェクト変数名.Add キー値, Array(セル１値, セル２値, セル３値)

で追加していって

書き出す際には0スタートである事を間違えず）

= Dictionaryオブジェクト変数名(キー値)(ItemのインデックスNo) 'セル１値ならインデックスNoは 0

どのセルを追加していきたいのか、どこのセルにどの配列の値を入れたいのかで出来るのではないかなと。