Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 在庫一覧更新

Excel VBA
スポンサーリンク

ねらい：入出庫を在庫マスタへ“安全に合算し、見える化まで”一括更新する

在庫一覧更新は「初期在庫＋入庫－出庫＝現在庫」を壊れないやり方で確定し、閾値（補充点、最小在庫）で警告まで出すのが肝です。配列I/O＋Dictionary＋正規化で「スピード」「正確さ」「列変更耐性」を確保し、初心者でも貼って動くテンプレを例題付きで解説します。

共通基盤：配列I/O・キー正規化・列指定

一括読み書き・キー生成・列指定ユーティリティ

' ModInv_Base.bas
Option Explicit
Private Const SEP As String = Chr$(30)

Public Function ReadRegion(ByVal ws As Worksheet, Optional ByVal topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

Public Sub WriteBlock(ByVal ws As Worksheet, ByVal a As Variant, ByVal topLeft As String)
    ws.Range(topLeft).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function NormKey(ByVal v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v))) ' 大小無視・前後空白除去
End Function

Public Function ColsToIndex(ByVal csv As String) As Long()
    Dim p() As String: p = Split(csv, ",")
    Dim idx() As Long: ReDim idx(0 To UBound(p))
    Dim i As Long
    For i = 0 To UBound(p): idx(i) = Range(Trim$(p(i)) & "1").Column: Next
    ColsToIndex = idx
End Function

Public Function ToNumberOrZero(ByVal v As Variant) As Double
    If IsNumeric(v) Then ToNumberOrZero = CDbl(v) Else ToNumberOrZero = 0#
End Function
VB

重要ポイントの深掘り

  • ヘッダは1行目固定、データは2行目から扱い、事故を激減させます。
  • キーは NormKey（Trim＋LCase）で揺らぎを除去し、同じ商品が別物になる誤集計を防ぎます。
  • 列は文字で指定（”A,C,E”）。列追加・入替に強く、現場の変更に耐えます。

在庫更新の核：初期在庫＋入庫－出庫＝現在庫

在庫マスタへ入出庫明細を合算して現在庫・差分を出す

' ModInv_Update.bas
Option Explicit

' master: 在庫マスタ（A=商品ID, B=商品名, C=初期在庫, D=最小在庫, E=補充点）
' move:   入出庫明細（A=商品ID, B=日付, C=数量, D=種別 "IN"/"OUT"）
' outStart: 出力開始セル（例 "Z1"）
Public Sub UpdateInventory(ByVal master As String, ByVal move As String, ByVal outStart As String)
    Dim aM As Variant: aM = ReadRegion(Worksheets(master))
    Dim aV As Variant: aV = ReadRegion(Worksheets(move))

    ' 明細集計：key → net（入庫＋、出庫−）、inCount、outCount
    Dim net As Object: Set net = CreateObject("Scripting.Dictionary"): net.CompareMode = 1
    Dim inCnt As Object: Set inCnt = CreateObject("Scripting.Dictionary"): inCnt.CompareMode = 1
    Dim outCnt As Object: Set outCnt = CreateObject("Scripting.Dictionary"): outCnt.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(aV, 1)
        Dim k As String: k = NormKey(aV(r, 1))
        Dim qty As Double: qty = ToNumberOrZero(aV(r, 3))
        Dim typ As String: typ = UCase$(Trim$(CStr(aV(r, 4))))
        Dim delta As Double: delta = IIf(typ = "IN", qty, IIf(typ = "OUT", -qty, 0#))
        net(k) = IIf(net.Exists(k), net(k) + delta, delta)
        If typ = "IN" Then
            inCnt(k) = IIf(inCnt.Exists(k), inCnt(k) + 1, 1)
        ElseIf typ = "OUT" Then
            outCnt(k) = IIf(outCnt.Exists(k), outCnt(k) + 1, 1)
        End If
    Next

    ' 出力配列：商品ID, 商品名, 初期在庫, 変動合計, 現在庫, 最小在庫, 補充点, 要補充, 入庫件数, 出庫件数
    Dim outCols As Long: outCols = 10
    Dim out() As Variant: ReDim out(1 To UBound(aM, 1), 1 To outCols)
    out(1, 1) = aM(1, 1): out(1, 2) = aM(1, 2): out(1, 3) = aM(1, 3)
    out(1, 4) = "MovementSum": out(1, 5) = "CurrentStock"
    out(1, 6) = aM(1, 4): out(1, 7) = aM(1, 5)
    out(1, 8) = "ReplenishFlag": out(1, 9) = "IN_Count": out(1, 10) = "OUT_Count"

    For r = 2 To UBound(aM, 1)
        Dim key As String: key = NormKey(aM(r, 1))
        Dim init As Double: init = ToNumberOrZero(aM(r, 3))
        Dim mov As Double: mov = IIf(net.Exists(key), net(key), 0#)
        Dim cur As Double: cur = init + mov
        out(r, 1) = aM(r, 1)
        out(r, 2) = aM(r, 2)
        out(r, 3) = init
        out(r, 4) = mov
        out(r, 5) = cur
        out(r, 6) = aM(r, 4) ' 最小在庫
        out(r, 7) = aM(r, 5) ' 補充点
        out(r, 8) = IIf(cur <= ToNumberOrZero(aM(r, 7)), "Replenish", IIf(cur <= ToNumberOrZero(aM(r, 6)), "Low", "OK"))
        out(r, 9) = IIf(inCnt.Exists(key), inCnt(key), 0)
        out(r, 10) = IIf(outCnt.Exists(key), outCnt(key), 0)
    Next

    WriteBlock Worksheets(master), out, outStart
    Call FormatInventoryView(Worksheets(master), outStart)
End Sub

Private Sub FormatInventoryView(ByVal ws As Worksheet, ByVal startAddr As String)
    Dim rng As Range: Set rng = ws.Range(startAddr).CurrentRegion
    rng.Columns("E").NumberFormatLocal = "#,##0" ' 現在庫
    rng.Columns("C").NumberFormatLocal = "#,##0" ' 初期在庫
    rng.Columns("D").NumberFormatLocal = "#,##0" ' 変動合計
    rng.Columns.AutoFit
    ' 条件付き書式：Replenish=赤, Low=黄
    With rng
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$H2=""Replenish"""
        .FormatConditions(1).Interior.Color = RGB(255, 200, 200)
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$H2=""Low"""
        .FormatConditions(2).Interior.Color = RGB(255, 255, 180)
    End With
End Sub
VB

重要ポイントの深掘り

  • 入出庫は「IN=＋」「OUT=−」の符号を最初に決め、揺らぎ（in/out/入庫/出庫）を正規化しましょう。
  • 閾値は二段構えが実務的（補充点と最小在庫）。補充点以下を赤、最小在庫以下を黄にすると判断が速いです。
  • 結果は配列で作って一括書き戻し。セル逐次は遅く、UIが固まります。

入出庫明細の検証：不正レコード・負在庫・ゼロ出庫の見える化

明細クレンジングと警告フラグの付与

' ModInv_ValidateMoves.bas
Option Explicit

' move: A=商品ID, B=日付, C=数量, D=種別
' 出力：InvalidFlag, Reason を付与
Public Sub ValidateMoves(ByVal move As String, ByVal outStart As String)
    Dim a As Variant: a = ReadRegion(Worksheets(move))
    Dim out() As Variant: ReDim out(1 To UBound(a, 1), 1 To 2)
    out(1, 1) = "InvalidFlag": out(1, 2) = "Reason"

    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim qty As Double: qty = ToNumberOrZero(a(r, 3))
        Dim typ As String: typ = LCase$(Trim$(CStr(a(r, 4))))
        Dim reason As String: reason = ""
        If Len(Trim$(CStr(a(r, 1)))) = 0 Then reason = "NoProductID"
        If qty = 0 Then reason = IIf(Len(reason) > 0, reason & "|", "") & "ZeroQty"
        If typ <> "in" And typ <> "out" Then reason = IIf(Len(reason) > 0, reason & "|", "") & "InvalidType"
        out(r, 1) = IIf(Len(reason) > 0, "NG", "")
        out(r, 2) = reason
    Next
    WriteBlock Worksheets(move), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 商品ID無し、数量ゼロ、種別不正は“入出庫の三大不正”。入口で弾くか、要レビューに回すのが安全です。
  • 複数理由を“|”で連結すると、現場修正の指示が明確になります。

ロット別・倉庫別在庫：複合キーで残高を持つ

ロット×倉庫の在庫更新（多拠点・賞味期限対応）

' ModInv_LotWarehouse.bas
Option Explicit
Private Const SEP As String = Chr$(30)

' master: A=商品ID, B=商品名, C=ロット, D=倉庫, E=初期在庫
' move:   A=商品ID, B=ロット, C=倉庫, D=数量, E=種別
Public Sub UpdateLotWarehouse(ByVal master As String, ByVal move As String, ByVal outStart As String)
    Dim aM As Variant: aM = ReadRegion(Worksheets(master))
    Dim aV As Variant: aV = ReadRegion(Worksheets(move))

    Dim net As Object: Set net = CreateObject("Scripting.Dictionary"): net.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(aV, 1)
        Dim k As String: k = NormKey(aV(r, 1)) & SEP & NormKey(aV(r, 2)) & SEP & NormKey(aV(r, 3))
        Dim qty As Double: qty = ToNumberOrZero(aV(r, 4))
        Dim typ As String: typ = UCase$(Trim$(CStr(aV(r, 5))))
        Dim delta As Double: delta = IIf(typ = "IN", qty, IIf(typ = "OUT", -qty, 0#))
        net(k) = IIf(net.Exists(k), net(k) + delta, delta)
    Next

    ' 出力：商品ID, 名称, ロット, 倉庫, 初期, 変動, 現在
    Dim out() As Variant: ReDim out(1 To UBound(aM, 1), 1 To 7)
    out(1, 1) = aM(1, 1): out(1, 2) = aM(1, 2): out(1, 3) = aM(1, 3)
    out(1, 4) = aM(1, 4): out(1, 5) = aM(1, 5)
    out(1, 6) = "MovementSum": out(1, 7) = "CurrentStock"

    For r = 2 To UBound(aM, 1)
        Dim key As String: key = NormKey(aM(r, 1)) & SEP & NormKey(aM(r, 3)) & SEP & NormKey(aM(r, 4))
        Dim init As Double: init = ToNumberOrZero(aM(r, 5))
        Dim mov As Double: mov = IIf(net.Exists(key), net(key), 0#)
        out(r, 1) = aM(r, 1)
        out(r, 2) = aM(r, 2)
        out(r, 3) = aM(r, 3)
        out(r, 4) = aM(r, 4)
        out(r, 5) = init
        out(r, 6) = mov
        out(r, 7) = init + mov
    Next
    WriteBlock Worksheets(master), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 複合キーは“安全な区切り”で束ねて衝突を防ぐ（単純連結は危険）。
  • ロットや倉庫が空の場合の扱いは運用で統一（空なら“未指定”にする等）。

補充計画：リードタイム・安全在庫込みの発注提案

補充量の試算（補充点＝安全在庫＋需要×リードタイム）

' ModInv_Replenish.bas
Option Explicit

' A=商品ID, B=名称, C=現在庫, D=安全在庫, E=平均日販, F=リードタイム(日)
' 出力：不足量、提案発注量
Public Sub SuggestReplenish(ByVal sheetName As String, ByVal outStart As String)
    Dim a As Variant: a = ReadRegion(Worksheets(sheetName))
    Dim out() As Variant: ReDim out(1 To UBound(a, 1), 1 To 5)
    out(1, 1) = a(1, 1): out(1, 2) = a(1, 2): out(1, 3) = "CurrentStock"
    out(1, 4) = "Shortage": out(1, 5) = "OrderQty"

    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim cur As Double: cur = ToNumberOrZero(a(r, 3))
        Dim saf As Double: saf = ToNumberOrZero(a(r, 4))
        Dim daily As Double: daily = ToNumberOrZero(a(r, 5))
        Dim lt As Double: lt = ToNumberOrZero(a(r, 6))
        Dim reorderPoint As Double: reorderPoint = saf + daily * lt
        Dim shortage As Double: shortage = IIf(cur < reorderPoint, reorderPoint - cur, 0#)
        ' 端数処理：箱単位など要件に合わせて丸める
        Dim orderQty As Double: orderQty = Application.WorksheetFunction.RoundUp(shortage, 0)
        out(r, 1) = a(r, 1)
        out(r, 2) = a(r, 2)
        out(r, 3) = cur
        out(r, 4) = shortage
        out(r, 5) = orderQty
    Next
    WriteBlock Worksheets(sheetName), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 補充点＝安全在庫＋需要×リードタイムを基準にすると、欠品を減らしつつ在庫過多を抑えられます。
  • 発注単位（箱/ケース）に合わせて丸め方を仕様化。誤丸めは現場負担になります。

例題の通し方：明細検証→在庫更新→ロット倉庫→補充提案→見える化

パイプライン実行例

' ModInv_Example.bas
Option Explicit

Public Sub Run_InventoryPipeline()
    ' 1) 明細検証（ゼロ数量などの不正を見える化）
    ValidateMoves "Moves", "Z1"

    ' 2) 在庫更新（商品別に現在庫・警告フラグ）
    UpdateInventory "Inventory", "Moves", "AA1"

    ' 3) ロット×倉庫在庫（必要なら）
    ' UpdateLotWarehouse "InventoryLot", "MovesLot", "AC1"

    ' 4) 補充提案（安全在庫・平均日販・リードタイムから試算）
    SuggestReplenish "ReplenishBase", "AE1"

    MsgBox "在庫一覧更新パイプラインが完了しました。", vbInformation
End Sub
VB

期待動作の確認ポイント

  • 不正明細が“NG/理由”で一覧化。
  • 現在庫・変動合計・補充フラグがヘッダ付きで出力され、閾値で色分け。
  • 補充提案が妥当な値で算出され、丸め方が要件通りになっている。

落とし穴と対策（深掘り）

種別の揺らぎ（IN/OUT/入庫/出庫）

  • 対策: 入力時に必ず“IN/OUT”へ正規化。日本語表記は入口で英字へ変換して辞書化。

商品IDの前後空白・大小違いで別物化

  • 対策: NormKey を徹底。両側（マスタ・明細）で同じ関数を通す。

文字数値・テキスト日付で合算が壊れる

  • 対策: ToNumberOrZero/CDateを入口で適用。失敗は0/空へ統一。

マイナス在庫（負在庫）

  • 対策: “許容/禁止”を先に運用決定。禁止なら出庫前チェック（現在庫−出庫 < 0 をNGに）を追加。

セル逐次書きで遅い

  • 対策: 結果は配列で作って最後に一括書き戻し。10万行でもUIが安定。

まとめ：在庫更新は「正規化→合算→閾値判定→見える化」の型で強くする

明細を正し、入出庫を安全に合算し、現在庫を確定。補充点・最小在庫で警告を色分けし、必要ならロット・倉庫別に拡張。配列I/O＋Dictionary＋正規化の三点セットを守れば、規模が大きくても壊れません。

スポンサーリンク
タイトルとURLをコピーしました