商品在庫画面の受払履歴作成 [VBA在庫管理システムVer01#27]

前回、商品在庫画面の商品在庫表 及び 商品検索を作成しました。

この記事では、受払履歴リストを作成していきます。

VBA在庫管理システムVer01

商品在庫の受払履歴作成

受払履歴の表示

受払履歴を表示するプロシージャをサブルーチンとして作成します。
少し長くなってしまいましたが、頑張って読み取ってみて下さい。

Sub ShowItemStockDetailList()

    Application.ScreenUpdating = False

'作業ブックを開く
Workbooks.Open データ位置 & "在庫管理DATA.xlsx"
    
'オブジェクト変数の取得
Dim wsItemMaster As Worksheet, wsItemInOut As Worksheet, wsStockExtraction As Worksheet
Set wsItemMaster = Workbooks("在庫管理DATA.xlsx").Sheets("M_商品")
Set wsItemInOut = Workbooks("在庫管理DATA.xlsx").Sheets("T_入出庫")
Set wsStockExtraction = Workbooks("在庫管理DATA.xlsx").Sheets("受払抽出")

'棚卸し情報取得
Dim 検索行 As Long
検索行 = wsItemMaster.Range("A:A").Find(Val(lstStock.List(lstStock.ListIndex, 0)), lookat:=xlWhole).Row

'抽出条件の設定
wsStockExtraction.Activate
wsStockExtraction.Cells(2, 1).Value = lstStock.List(lstStock.ListIndex, 0)
wsStockExtraction.Cells(2, 2).Value = ">" & wsItemMaster.Cells(検索行, wsItemMasterColumns.M棚卸日).Value

'受払抽出
wsItemInOut.Columns("A:T").AdvancedFilter _
 Action:=xlFilterCopy, _
 CriteriaRange:=wsStockExtraction.Range("A1:C2"), _
 CopyToRange:=wsStockExtraction.Range("F1:I1")

'棚卸し情報追記
With wsStockExtraction
    .Activate
    .Range("F2:I2").Insert shift:=xlDown

    .Cells(2, 6).Value = 0
    .Cells(2, 7).Value = wsItemMaster.Cells(検索行, wsItemMasterColumns.M棚卸日).Value
    .Cells(2, 8).Value = "棚卸数"
    .Cells(2, 9).Value = wsItemMaster.Cells(検索行, wsItemMasterColumns.M棚卸数).Value
End With

'入出庫区分/入出庫日を降順/昇順で並べ替え
wsStockExtraction.Range("F1").Sort key1:=wsStockExtraction.Range("H1"), order1:=xlDescending, Header:=xlYes
wsStockExtraction.Range("F1").Sort key1:=wsStockExtraction.Range("G1"), order1:=xlAscending, Header:=xlYes

'最終行の取得
Dim wsStockExtractionRow As Long
wsStockExtractionRow = wsStockExtraction.Cells(Rows.Count, 6).End(xlUp).Row

'同一日付で合計
Dim i As Long

With wsStockExtraction
    For i = wsStockExtractionRow To 4 Step -1
        If .Cells(i, 7).Value = .Cells(i - 1, 7).Value And .Cells(i, 8).Value = .Cells(i - 1, 8).Value Then
                .Cells(i - 1, 9).Value = .Cells(i, 9).Value + .Cells(i - 1, 9).Value
                .Range(Cells(i, 6), Cells(i, 9)).Delete shift:=xlUp
        End If
    Next
End With

'受払履歴データの取り込み
Dim aryStockDetail() As Variant

'最終行の再取得
wsStockExtractionRow = wsStockExtraction.Cells(Rows.Count, 6).End(xlUp).Row

'変数の設定
ReDim aryStockDetail(wsStockExtractionRow - 2, 4) As Variant

'変数への取り込み
For i = 0 To wsStockExtractionRow - 2

    '入出庫日
    aryStockDetail(i, 0) = Format(wsStockExtraction.Cells(i + 2, 7), "yy/mm/dd")

    '入出庫区分
    aryStockDetail(i, 1) = wsStockExtraction.Cells(i + 2, 8)

    '入出庫数
    If aryStockDetail(i, 1) = "　出庫" Then
        aryStockDetail(i, 2) = wsStockExtraction.Cells(i + 2, 9) * -1
    Else
        aryStockDetail(i, 2) = wsStockExtraction.Cells(i + 2, 9)
    End If

    '在庫数
    If i = 0 Then
        aryStockDetail(i, 3) = aryStockDetail(i, 2)
    Else
        aryStockDetail(i, 3) = aryStockDetail(i - 1, 3) + aryStockDetail(i, 2)
    End If

    '発注フラグ
    If aryStockDetail(i, 3) <= wsItemMaster.Cells(検索行, wsItemMasterColumns.M発注点) Then
        aryStockDetail(i, 4) = "〇"
    Else
        aryStockDetail(i, 4) = ""
    End If

Next

'受払履歴リストボックスの設定
With lstStockDetail
    .Clear
    .ColumnCount = 5
    .ColumnWidths = "100;100;80;80;40"

    .List = aryStockDetail
End With

'作業ブックを閉じる
Workbooks("在庫管理DATA.xlsx").Close savechanges:=False

    Application.ScreenUpdating = True

End Sub

@1. シートの描画を止める
Application.ScreenUpdatingをFalsに設定に設定します。

@2.作業ブックを開く
データブックを開き、作業シートを変数に格納します。

@3.棚卸情報取得
M_商品シートから棚卸情報を取得するため、商品IDで該当行を検索し、変数に取り込みます。

@4.フィルターオプションの設定
検索条件を書き込みます。入出庫日は棚卸日より後とし、商品IDの受払履歴を抽出します。

@5.フィルターオプションの実行
フィルターオプションを実行します。検索条件範囲は"A1:C2"となるので、注意してください。

@6.棚卸情報の追加
抽出結果の先頭行に棚卸情報を追加します。

@7.シートの並び替え
入出庫区分を降順に、入出庫日を昇順で並べ替え、リストを成形します。
ここで、抽出結果の最終行を取得します。取得列は F列となります。

@8.同一日付で合計
入出庫日・入出庫区分が同一のものは入出庫数を合計し、日毎の受払データとします。最終行からループし、１行上の入出庫日・入出庫区分が同一か判定していきます。同一だった場合、１行上の入出庫数に該当行の入出庫数を加算し、該当行は削除します。
入出庫数の合計の後、取り込み用に抽出結果の最終行を再取得します。

@9.受払データの取得
抽出結果を１行づつループしてデータを取得します。
① 入出庫日・入出庫区分を、配列変数に取り込みます。
② 入出庫数を、配列変数に取り込みます。ただし、入出庫区分が"　出庫"の時は、マイナス表示にして取り込みます。
③ 在庫数を棚卸数を基準に累積しながら、配列変数に取り込みます。
ただし、１行目は棚卸情報なので、累積せずに棚卸数を取り込みます。
④ ③で取得したデータを利用して、発注Flagを発行し、配列変数に取り込みます。

@10.受払履歴リストへの表示
ColumnWidthsで表示状態を設定し、受払履歴リストボックスへ表示します。

@11.ブックの立ち下げ
シートを操作してますので、初期化するため、ブックは保存せずに閉じます。
また、Application.ScreenUpdatingもTrue設定に戻します。

受払履歴の表示設定

受払履歴リストは商品検索と連動して表示させます。そこで、cmbItemName_Changeプロシージャにコードを追加していきます。

詳細情報のリセット設定

詳細データをリセットするプロシージャに受払履歴の解除コードを追加します。

Sub Reset()

'詳細情報の表示解除
cmbItemID.Text = ""
texSupplier.Value = ""
texOrderUnit.Value = ""
texPackage.Value = ""
texMaxStock.Value = ""
texOrderPoint.Value = ""
texStockPosition.Value = ""

'商品在庫表の選択解除
lstStock.ListIndex = -1

'受払履歴の表示解除　　←ここを追加
lstStockDetail.Clear

End Sub

@1. 詳細情報の表示解除
各表示を削除します。

@2.商品在庫表の選択解除
インデックス番号 ＝ -1 を受け渡し、選択を解除します。

@3.受払履歴の表示解除
受払履歴リストボックスをクリアします。

商品名称コンボでの名称検索

商品名称コンボボックスの動作設定に受払履歴の表示コードを追加します。

Private Sub cmbItemName_Change()

'商品選択無し時の回避
If cmbItemName.ListIndex = -1 Then
    Call Reset
    Exit Sub
End If

'詳細情報の表示
With cmbItemName
    cmbItemID.ListIndex = .ListIndex
    texSupplier.Value = .List(.ListIndex, lstItemMasterColumns.L発注先)
    texOrderUnit.Value = .List(.ListIndex, lstItemMasterColumns.L発注単位)
    texPackage.Value = .List(.ListIndex, lstItemMasterColumns.L梱包数)
    texMaxStock.Value = .List(.ListIndex, lstItemMasterColumns.L最大在庫)
    texOrderPoint.Value = .List(.ListIndex, lstItemMasterColumns.L発注点)
    texStockPosition.Value = .List(.ListIndex, lstItemMasterColumns.L棚位置)
End With

'商品在庫表の選択
Dim i As Long

For i = 0 To lstStock.ListCount
    If lstStock.List(i, 0) = cmbItemName.List(cmbItemName.ListIndex, 0) Then
        lstStock.ListIndex = i
        Exit For
    End If
Next

'受払履歴の表示　　←ここを追加
Call ShowItemStockDetailList

End Sub

@1.異常値の回避
商品名称コンボの入力内容が商品名称コンボのリスト項目と合致しないときは、詳細情報をリセットします。
Resetプロシージャを呼び出し、詳細データをクリアした後、プロシージャを抜けます。

@2.詳細情報の表示
商品名称コンボの入力内容が商品名称コンボのリスト項目と合致したときは、商品名称コンボの各リスト項目をテキストボックスに表示させます。

@3.商品在庫表の選択
商品在庫表をループし、商品名称コンボの商品IDと合致するレコードを選択し、ループを抜けます。

@4.受払履歴の表示
サブルーチンを実行します。

商品在庫画面の受払履歴リストができました。
次回は在庫リストの動作設定を追加していきます。
www.minizaiko.com