| |
元シートは以下
商品名
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
