VBA 仕入管理3(Worksheet_Change2)

続きとなりますのでVBAシステム(仕入管理1)VBAシステム(仕入管理2)を見ていない方はVBAシステム(仕入管理1)とVBAシステム(仕入管理2)をご確認ください。

赤字のSubプロジャーPickC1 (cnt)、PickC2 (cnt)について中身を見ていきます。

PickC1 (cnt)、PickC2 (cnt)は筆者がつけたプロジャー名です。皆さんは自分で整理しやすい名前をご自由につけてください。

名前として使えないものは警告がでますのでそのときは変更してください。

PickC1 (cnt) 商品マスタからの抽出

(ワークシート:発注入力)

Private Sub 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:

以下の処理にErrorが発生した場合jump1:まで処理がとびます。

Dim Dth1 As Range
Set Dth1 = Worksheets(“商品マスタ”).Range(“A2”).CurrentRegion

変数Dth1をRange(セル範囲)型として宣言します。

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)
 ・
 ・
 ・

Application.WorksheetFunction.VLookupの記述でVBAでEXCEL関数VLOOKUPを使うことができます。

cntには商品コードが入っており仕入れ商品マスタから必要な情報を取得します。

2列目 品名、5列目 数量単位、・・・

VLookupが慣れていない方はVBA VLookupでぜひ検索してみてください。

If Err.Number <> 0 Then
  MsgBox (“検索値が見つかりません”)
End If

VLookupで検索値が見つからないとエラーが発生してOn Error GoTo jump1:が発動します。

Err.Numberに0以外が代入され「MsgBox (“検索値が見つかりません”)」メッセージが表示されます。

PickC2 品名から商品コードの検索

Private Sub PickC2(cnt) ‘商品名称の一部から商品候補リスト作成

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

プロジャーClrList は別途、下に記述しています。

Set Dth1 = Worksheets(“商品マスタ”).Range(“A1”).CurrentRegion
f = Dth1.Rows.Count

Dth1にWorksheets(“商品マスタ”)のA1セルを含む連続してデータが入力されている範囲を設定します。

変数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

「仕入商品マスタ」から該当する値を取得してセル(Cells(k, 1).Value)以下に列挙していきます。

For i = 2 To f・・・ NextIf Then ・・・ End ifでワークシート「商品マスタ」2列目(商品名)の2行目から最下行fまで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

ClrList()は入力候補欄のクリアです。リスト件数上限を100件としセル範囲Range(“A5:C100”)をクリアします。

クリアのちA5セルに移動(セレクト)します。

次回はVBAシステム(仕入管理4)Worksheet_SelectionChangeを解説します。

タイトルとURLをコピーしました