質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.37%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

検索

検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。

Q&A

解決済

1回答

24311閲覧

VBA Dictionary 1つのKeyに対して複数のItemを持たせることは可能でしょうか?

Cabriolet

総合スコア3

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

検索

検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。

0グッド

0クリップ

投稿2020/12/06 07:41

編集2020/12/07 05:26

前提・実現したいこと

いつもお世話になっております。
VBA初心者ですが宜しくお願い致します。

Vlookup関数の代替として、Dictionaryを使用しております。
そこで質問なのですが、1つのKeyに対して複数のItemを持たせることは可能でしょうか?
それとも、Dictionaryとは別の方法が良いのでしょうか?
お手数お掛けしますが、ご確認お願い致します。

検索結果の出力先 : Book_bのSheet_cのAQ列とAR列
検索値 : Book_bのSheet_cのJ列
検索範囲 : Book_dのSheet_eのC~H列
列番号 : 5と6(E列とF列)
検索方法 : 完全一致

該当のソースコード

下記のコードはDictionaryを使用し、1つのKeyに対して1つのItemを持たせております。

Dim d As String Dim e As Worksheet Dim b As String Dim c As Worksheet Dim hsaisho As Long Dim isaigo As Long Dim dic_bpl As Dictionary Dim buff As Variant Dim name_b As Long Dim name_c As Long d = Application.GetOpenFilename(",*.xlsx") If d <> "False" Then With Workbooks.Open(d) Set e = .Worksheets("Sheet1") End With Else MsgBox "キャンセルしました" Exit Sub End If b = Application.GetOpenFilename(",*.XLSX") If b <> "False" Then With Workbooks.Open(b) Set c = .Worksheets("Sheet1") End With Else MsgBox "キャンセルしました" Exit Sub End If Set dic_bpl = New Dictionary Cells(1, 43) = "BPL" isaigo = e.Cells(Rows.Count, 3).End(xlUp).row hsaisho = c.Cells(Rows.Count, 43).End(xlUp).row + 1 hsaigo = c.Cells(Rows.Count, 8).End(xlUp).row For name_c = 1 To isaigo If dic_bpl.Exists(e.Cells(name_c, 3).Value) = False Then dic_bpl.Add Key:=CStr(e.Cells(name_c, 3).Value), Item:=e.Cells(name_c, 6).Value End If Next name_c buff = c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)).Value For name_b = hsaisho To hsaigo buff(name_b, 43) = WorksheetFunction.RoundUp(c.Cells(name_b, 11).Value / dic_bpl.Item(CStr(buff(name_b, 10))), 0) Next name_b c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)) = buff

試したこと

・set Dictionary名 = nothing にしてから set Dictionary名 = new Dictionary

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

meg_

2020/12/06 11:49

コードは「コードの挿入」で記入してください。
Cabriolet

2020/12/07 05:29

meg 様 お世話になっております。 御指摘頂きありがとうございます。 質問を修正してみたのですが、問題ありませんでしょうか? 以後、回答者の方が見易い様に留意したいと思います。
guest

回答1

0

ベストアンサー

1つのKeyに対して複数のItemを持たせることは可能でしょうか?

ItemにArrayを設定できるので、Arrayにしてセットしてやればいいです。

例:

VBA

1 Dim dic As Object 2 Set dic = CreateObject("Scripting.Dictionary") 3 4 Dim vals As Variant 5 vals = Array("val1", "val2") 6 dic.Add "key1", vals 7 8 9 Dim outVals As Variant 10 outVals = dic.Item("key1") 11 Debug.Print outVals(0) & "と" & outVals(1)

結果

console

1val1とval2

ItemにDictionaryをセットする事も可能です。

VBA

1 Dim dic As Object 2 Set dic = CreateObject("Scripting.Dictionary") 3 4 ' set two Values. 5 Dim vals As Object 6 Set vals = CreateObject("Scripting.Dictionary") 7 vals.Add "E", "val1" 8 vals.Add "F", "val2" 9 dic.Add "key1", vals 10 11 ' get two Values. 12 Dim outVals As Object 13 Set outVals = dic.Item("key1") 14 15 Debug.Print outVals.Item("E") & "と" & outVals.Item("F")

結果

console

1val1とval2

投稿2020/12/06 10:10

編集2020/12/06 10:21
Y.H.

総合スコア7918

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Cabriolet

2020/12/07 05:22

Y.H.様 ご丁寧に教えて頂きありがとうございます。 今回はItemにArrayを設定して、実現したかったことが可能となりました。 今後とも宜しくお願い致します。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.37%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問