Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

575 / 76735

←次へ　｜　前へ→


	【81825】dictionaryの使い方で質問（その２）

煮詰まった - 21/6/17(木) 18:54 -


	引用なし

	パスワード

元シートは以下
商品名
a1
a2
a3
a4
a5

先シートは以下
商品名　　　　価格　　　　価格2
a2　　　　100　　　　200
a3　　　　110　　　　220
a4　　　　120　　　　240

元シートに先シートの商品名をキーに価格、価格２を取り込もうとした場合に

元シートに商品名のキーはあるが
先シートに商品名のキーがない場合の回避方法教えてください。

　　　 For m = 1 To UBound(c1)　'検索用配列の要素数分ループ
　　　　
　　　　　
　　　　　　Keyval = c1(m, 1)
　　　　　　
　　　　　　　 c1(m, 2) = myDic.Item(Keyval)(0)　'検索値のKeyでItemを抽出
　　　　　　　 c1(m, 3) = myDic.Item(Keyval)(1)　'検索値のKeyでItemを抽出
　　　　
　　　　　　　ここにで元シートに商品キーがあるが先シートに商品
　　　　　　　キーがない場合を教えてください。　　　　
　　　　Next m

Sub Sample2()

　　　　
　　　　Dim c1 As Variant
　　　　Dim c2 As Variant
　　　　
　　　　
　　　　Dim Keyval　　　As String
　　　　Dim ItemVal　　 As Variant
　　　　Dim ItemVal1　　 As String
　　　　Dim ItemVal2　　 As String
　　　　
　　　　Dim MaxRow　　　As Long
　　　　Dim n　　　　　 As Long
　　　　Dim m　　　　　 As Long
　　　　
　　　　Dim myDic　　　 As Object

　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("元").Select
　　　　Range("A1").Select
　　　　c1 = Range("A1:C9")

　　　　
　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("先").Select
　　　　Range("A1").Select
　　　　c2 = Range("A1:C9")

　　　　Set myDic = CreateObject("Scripting.Dictionary")
　　　　
　　　　For n = 1 To UBound(c2) '参照用の配列を要素数分ループ
　　　　　　　　　　　　　　
　　　　　　Keyval = c2(n, 1) '3.Keyを格納
　　　　　　ItemVal1 = c2(n, 2) '4.Itemを格納
　　　　　　ItemVal2 = c2(n, 3) '4.Itemを格納
　　　　　　
　　　　　　ItemVal = Array(ItemVal1, ItemVal2)
　　　　　　
　　　　　　
　　　　　　'登録されていなければ登録
　　　　　　'※Dictionaryは重複登録出来ない
　　　　　　'今回のサンプルデータは初めから重複はありません。
　　　　　　If Not myDic.Exists(Keyval) Then
　　　　　　
　　　　　　　　myDic.Add Keyval, ItemVal
　　　　　　　　
　　　　　　End If
　　　　　　
　　　　Next n
　　　　
　　　　For m = 1 To UBound(c1)　'検索用配列の要素数分ループ
　　　　
　　　　　
　　　　　　Keyval = c1(m, 1)
　　　　　　
　　　　　　　 c1(m, 2) = myDic.Item(Keyval)(0)　'検索値のKeyでItemを抽出
　　　　　　　 c1(m, 3) = myDic.Item(Keyval)(1)　'検索値のKeyでItemを抽出
　　　　
　　　　
　　　　Next m
　　　　
　　　　
　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("元").Select
　　　　Range("A1").Select
　　　　Range("A1:C9") = c1
　　　　
　　　　
　　　　Set myDic = Nothing
　　　　
　　　　Set c1 = Nothing
　　　　Set c2 = Nothing
　　　　
　　
　　End Sub

6 hits

▼

【81825】dictionaryの使い方で質問（その２） 煮詰まった 21/6/17(木) 18:54