続きとなりますのでVBAシステム（仕入管理１）VBAシステム（仕入管理２）を見ていない方はVBAシステム（仕入管理１）とVBAシステム（仕入管理２）をご確認ください。
赤字のSubプロジャーPickC1 (cnt)、PickC2 (cnt)について中身を見ていきます。
PickC1 (cnt)、PickC2 (cnt)は筆者がつけたプロジャー名です。皆さんは自分で整理しやすい名前をご自由につけてください。
名前として使えないものは警告がでますのでそのときは変更してください。
PickC1 (cnt) 商品マスタからの抽出
（ワークシート：発注入力）
On Error GoTo jump1
Set DTH1 = Worksheets(“商品マスタ”).Range(“A2”).CurrentRegion
Cells(5, 8).Value = cnt ‘商品CODE
‘品名
Cells(5, 9).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 2, False)
‘数量単位
Cells(5, 11).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 5, False)
‘入目
Cells(5, 12).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 6, False)
‘単価
Cells(5, 13).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 7, False)
‘仕入先CODE
Cells(5, 6).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 3, False)
‘仕入先名称
Cells(5, 7).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 4, False)
‘備考
Cells(5, 16).Value = Application.WorksheetFunction.VLookup(cnt, DTH1, 8, False)
jump1:
If Err.Number <> 0 Then
MsgBox (“検索値が見つかりません”)
End If
End Sub
一節づつ見ていきます。
On Error GoTo jump1:
Dim Dth1 As Range
Set Dth1 = Worksheets(“商品マスタ”).Range(“A2”).CurrentRegion
Dth1にA2セルを起点とする、セル範囲(下表ではA1:M18)を設定します。
CurrentRegionプロパティを使用すると、指定したセルを含むアクティブセル領域（連続してデータが入力されている範囲）を取得します。
アクティブセル領域 （ワークシート：商品マスタ）
Application.WorksheetFunction.VLookup
‘品名
Cells(5, 8).Value = Application.WorksheetFunction.VLookup(cnt, Dth1, 2, False)
‘数量単位
Cells(5, 9).Value = Application.WorksheetFunction.VLookup(cnt, Dth1, 5, False)
・
・
・
cntには商品コードが入っており仕入れ商品マスタから必要な情報を取得します。
2列目 品名、5列目 数量単位、・・・
VLookupが慣れていない方はVBA VLookupでぜひ検索してみてください。
If Err.Number <> 0 Then
MsgBox (“検索値が見つかりません”)
End If
Err.Numberに0以外が代入され「MsgBox (“検索値が見つかりません”)」メッセージが表示されます。
PickC2 品名から商品コードの検索
ClrList
On Error GoTo jump1
Dim DTH1 As Range
Set DTH1 = Worksheets(“仕入商品マスタ”).Range(“A1”).CurrentRegion
f = DTH1.Rows.Count
k = 6
For i = 2 To f
If DTH1.Cells(i, 2).Value Like cnt Then
Cells(k, 1).Value = DTH1.Cells(i, 1).Value ‘商品CODE
Cells(k, 2).Value = DTH1.Cells(i, 2).Value ‘商品名
Cells(k, 3).Value = DTH1.Cells(i, 12).Value‘備考
k = k + 1
If k > 100 Then
MsgBox (“100件を超えました。”)
Exit Sub
End If
End If
Next
jump1:
End Sub
Set Dth1 = Worksheets(“商品マスタ”).Range(“A1”).CurrentRegion
f = Dth1.Rows.Count
変数fにDth1セル範囲の最下行数Rows.Countを代入します。
k = 5
For i = 2 To f
If Dth1.Cells(i, 2).Value Like cnt Then
Cells(k, 1).Value = DTH1.Cells(i, 1).Value ‘商品CODE
Cells(k, 2).Value = DTH1.Cells(i, 2).Value ‘商品名
Cells(k, 3).Value = DTH1.Cells(i, 12).Value ‘備考
k = k + 1
If k > 100 Then
MsgBox (“100件を超えました。”)
Exit Sub
End If
End If
Next
For i = 2 To f・・・ NextとIf Then ・・・ End ifでワークシート「商品マスタ」2列目（商品名)の2行目から最下行ｆまでcntに代入された値と比較していきます。
Like cntはcntに代入された値と部分的に一致するものを抽出する方法、ちなみに= cntだと完全一致するものが抽出できます。
部分一致した「商品マスタ」のデータから商品CODEと商品名と備考をA列とB列とC列に代入していきます。
該当する商品が複数ある場合にk = k + 1で書き込む行をひとつ下に移動していきます。
抽出された商品が多数あった場合、選択するのに効率が悪いので上限を決め100件以上では処理を出ます。
Sub ClrList()
‘入力候補欄クリア
ActiveSheet.Range(“A5:C100”).Select
Selection.ClearContents
Range(“A5”).Select
End Sub
クリアのちA5セルに移動（セレクト）します。
次回はVBAシステム（仕入管理４）Worksheet_SelectionChangeを解説します。