Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 受発注管理テンプレ

Excel VBA
スポンサーリンク

ねらい：受注・発注・在庫・納期・請求の「一連の流れ」を安全に自動化する

受発注管理は「受注登録→在庫確保→不足分を発注→納期トラッキング→出荷・売上→請求」の流れを同じ型で回すほど強くなります。VBAなら“配列I/O＋Dictionary＋ステータス遷移＋不足検知→自動発注起票”で、事故を減らし、スピードと再現性を両立できます。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。

データ設計：シート構成とカラム定義（壊れない最小構成）

基本のシートと列

  • Orders（受注）: A=受注ID, B=受注日, C=顧客ID, D=商品ID, E=数量, F=希望納期, G=ステータス（New/Allocated/Shipped/Invoiced）
  • Inventory（在庫）: A=商品ID, B=商品名, C=現在庫, D=安全在庫, E=補充点, F=引当済（Allocated）
  • POs（発注）: A=発注ID, B=発注日, C=仕入先ID, D=商品ID, E=数量, F=納期, G=ステータス（Ordered/Received）
  • Shipments（出荷）: A=出荷ID, B=出荷日, C=受注ID, D=商品ID, E=数量
  • Invoices（請求）: A=請求ID, B=請求日, C=顧客ID, D=受注ID, E=金額, F=状態（Draft/Sent）

重要ポイントの深掘り

ステータスを明示し、遷移を「New→Allocated→Shipped→Invoiced」に固定します。Inventoryは“現在庫＋引当済”を分けて持つことで、受注割り当てと発注判断が安全に行えます。受注や発注はID主キーで結び、商品IDを正規化（前後空白・大小を統一）してグループ割れを防ぎます。

共通基盤：配列I/O・キー正規化・安全変換

ユーティリティ（貼って動く最小セット）

' ModOM_Base.bas
Option Explicit

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

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

Public Function NormKey(v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v)))
End Function

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

Public Function ToDateOrEmpty(v As Variant) As Variant
    If IsDate(v) Then ToDateOrEmpty = CDate(v) Else ToDateOrEmpty = ""
End Function

Public Sub FormatBlock(ws As Worksheet, startCell As String, Optional numberColsCsv As String = "")
    With ws.Range(startCell).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
    If Len(numberColsCsv) > 0 Then
        Dim cols() As String: cols = Split(numberColsCsv, ",")
        Dim i As Long
        For i = LBound(cols) To UBound(cols)
            ws.Columns(Trim$(cols(i))).NumberFormatLocal = "#,##0"
        Next
    End If
End Sub
VB

重要ポイントの深掘り

入口で「商品ID・顧客IDの正規化」「数量・金額の数値化」「日付の確定」を必ず通します。これだけで在庫引当・発注判断・請求集計の事故（文字数値・テキスト日付・キー揺らぎ）を激減できます。出力は必ず一括書式適用し、レビュー性を標準化します。

受注→在庫引当：不足の検知と自動発注起票

受注の引当と不足抽出（受注ステータスの更新）

' ModOM_Allocate.bas
Option Explicit

' 引当ロジック：在庫の範囲で受注をAllocatedにし、足りない分を不足として抽出
' Orders: A=受注ID, D=商品ID, E=数量, G=ステータス
' Inventory: A=商品ID, C=現在庫, F=引当済
Public Sub AllocateOrders()
    Dim wsO As Worksheet: Set wsO = Worksheets("Orders")
    Dim wsI As Worksheet: Set wsI = Worksheets("Inventory")
    Dim o As Variant: o = ReadRegion(wsO)
    Dim inv As Variant: inv = ReadRegion(wsI)

    ' 商品→在庫情報
    Dim cur As Object: Set cur = CreateObject("Scripting.Dictionary"): cur.CompareMode = 1
    Dim alloc As Object: Set alloc = CreateObject("Scripting.Dictionary"): alloc.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(inv, 1)
        Dim pid As String: pid = NormKey(inv(r, 1))
        cur(pid) = ToNumberOrZero(inv(r, 3))
        alloc(pid) = ToNumberOrZero(inv(r, 6))
    Next

    ' 不足集計（商品→不足数量）
    Dim shortage As Object: Set shortage = CreateObject("Scripting.Dictionary"): shortage.CompareMode = 1

    For r = 2 To UBound(o, 1)
        Dim pid As String: pid = NormKey(o(r, 4))
        Dim qty As Double: qty = ToNumberOrZero(o(r, 5))
        Dim avail As Double: avail = IIf(cur.Exists(pid), cur(pid), 0) - IIf(alloc.Exists(pid), alloc(pid), 0)

        If qty <= avail Then
            ' 引当成功
            alloc(pid) = alloc(pid) + qty
            o(r, 7) = "Allocated"
        Else
            ' 部分引当（可能なら）→不足を記録
            If avail > 0 Then
                alloc(pid) = alloc(pid) + avail
            End If
            Dim lack As Double: lack = qty - IIf(avail > 0, avail, 0)
            If lack > 0 Then
                shortage(pid) = IIf(shortage.Exists(pid), shortage(pid) + lack, lack)
            End If
            o(r, 7) = "New"
        End If
    Next

    ' 引当済在庫の書き戻し
    Dim iRow As Long
    For iRow = 2 To UBound(inv, 1)
        Dim pid As String: pid = NormKey(inv(iRow, 1))
        inv(iRow, 6) = IIf(alloc.Exists(pid), alloc(pid), 0) ' F=引当済
    Next

    WriteBlock wsO, o, "A1"
    WriteBlock wsI, inv, "A1"
    FormatBlock wsO, "A1", "E"
    FormatBlock wsI, "A1", "C,F"

    ' 不足一覧をPO起票に渡す
    BuildPurchaseOrdersFromShortage shortage
End Sub
VB

不足から発注書起票（仕入先ルールを簡易適用）

' ModOM_PO.bas
Option Explicit

' VendorMap: 商品→仕入先 の単純ルール（実務はMasterから引く）
Private Function VendorForProduct(pid As String) As String
    ' 例：商品ID先頭で仕入先を分ける
    If Left$(pid, 1) = "a" Then VendorForProduct = "SUP-A" Else VendorForProduct = "SUP-B"
End Function

' POs: A=発注ID, B=発注日, C=仕入先ID, D=商品ID, E=数量, F=納期, G=ステータス
Public Sub BuildPurchaseOrdersFromShortage(shortage As Object)
    If shortage Is Nothing Then Exit Sub
    Dim wsP As Worksheet: Set wsP = Worksheets("POs")
    Dim p As Variant: p = ReadRegion(wsP)

    Dim out() As Variant: ReDim out(1 To shortage.Count + 1, 1 To 7)
    out(1, 1) = "PO_ID": out(1, 2) = "PO_Date": out(1, 3) = "VendorID": out(1, 4) = "ProductID"
    out(1, 5) = "Qty": out(1, 6) = "DueDate": out(1, 7) = "Status"

    Dim i As Long: i = 2
    Dim k As Variant
    For Each k In shortage.Keys
        out(i, 1) = "PO-" & Format(Now, "yyyymmdd") & "-" & Format(i - 1, "000")
        out(i, 2) = Format(Date, "yyyy-mm-dd")
        out(i, 3) = VendorForProduct(CStr(k))
        out(i, 4) = CStr(k)
        out(i, 5) = shortage(k)
        out(i, 6) = Format(DateAdd("d", 7, Date), "yyyy-mm-dd") ' 納期=7日後（例）
        out(i, 7) = "Ordered"
        i = i + 1
    Next

    WriteBlock wsP, out, "Z1" ' 既存の発注表とは分けて出力（追記運用は実務に合わせて）
    FormatBlock wsP, "Z1", "E"
End Sub
VB

重要ポイントの深掘り

在庫引当は「現在庫−引当済」の実質残から判断します。不足は商品単位で集約し、仕入先ルールに沿って一括起票。発注は“納期の初期値を決める関数”にしておくと運用が楽です。引当でステータスを即時更新し、発注起票の根拠（不足合計）が追跡できる形に。

入庫→在庫反映→受注進捗：ステータス遷移の自動化

入庫処理で在庫増加とPO受領

' ModOM_Receive.bas
Option Explicit

' 入庫シート（例）：Receipts A=受領ID, B=受領日, C=発注ID, D=商品ID, E=数量
Public Sub ApplyReceipts()
    Dim wsR As Worksheet: Set wsR = Worksheets("Receipts")
    Dim wsI As Worksheet: Set wsI = Worksheets("Inventory")
    Dim wsP As Worksheet: Set wsP = Worksheets("POs")

    Dim r As Variant: r = ReadRegion(wsR)
    Dim inv As Variant: inv = ReadRegion(wsI)
    Dim p As Variant: p = ReadRegion(wsP)

    ' 商品→在庫行idx
    Dim iIdx As Object: Set iIdx = CreateObject("Scripting.Dictionary"): iIdx.CompareMode = 1
    Dim ri As Long
    For ri = 2 To UBound(inv, 1): iIdx(NormKey(inv(ri, 1))) = ri: Next

    ' 発注→行idx
    Dim pIdx As Object: Set pIdx = CreateObject("Scripting.Dictionary"): pIdx.CompareMode = 1
    Dim pi As Long
    For pi = 2 To UBound(p, 1): pIdx(NormKey(p(pi, 1))) = pi: Next

    ' 受領ループ
    Dim rr As Long
    For rr = 2 To UBound(r, 1)
        Dim pid As String: pid = NormKey(r(rr, 4))
        Dim qty As Double: qty = ToNumberOrZero(r(rr, 5))
        If iIdx.Exists(pid) Then
            inv(iIdx(pid), 3) = ToNumberOrZero(inv(iIdx(pid), 3)) + qty ' 現在庫+受領
        End If
        Dim poId As String: poId = NormKey(r(rr, 3))
        If pIdx.Exists(poId) Then p(pIdx(poId), 7) = "Received"
    Next

    WriteBlock wsI, inv, "A1"
    WriteBlock wsP, p, "A1"
    FormatBlock wsI, "A1", "C"
    FormatBlock wsP, "A1", "E"
End Sub
VB

引当の再試行と出荷・売上への進行

' ModOM_Progress.bas
Option Explicit

Public Sub ReallocateAndShip()
    ' 1) 再引当
    AllocateOrders

    ' 2) 出荷対象を抽出（Allocatedの受注）
    Dim wsO As Worksheet: Set wsO = Worksheets("Orders")
    Dim o As Variant: o = ReadRegion(wsO)

    Dim wsS As Worksheet: Set wsS = Worksheets("Shipments")
    Dim out() As Variant: ReDim out(1 To 1, 1 To 5)
    out(1, 1) = "ShipID": out(1, 2) = "ShipDate": out(1, 3) = "OrderID": out(1, 4) = "ProductID": out(1, 5) = "Qty"

    Dim rows As Long: rows = 1
    Dim r As Long
    For r = 2 To UBound(o, 1)
        If LCase$(CStr(o(r, 7))) = "allocated" Then
            rows = rows + 1: ReDim Preserve out(1 To rows, 1 To 5)
            out(rows, 1) = "S-" & Format(Now, "yyyymmdd") & "-" & Format(rows - 1, "000")
            out(rows, 2) = Format(Date, "yyyy-mm-dd")
            out(rows, 3) = o(r, 1)
            out(rows, 4) = o(r, 4)
            out(rows, 5) = o(r, 5)
            o(r, 7) = "Shipped"
        End If
    Next

    ' 3) 出荷書き込み＋請求起票（簡易）
    If rows > 1 Then
        WriteBlock wsS, out, "Z1"
        FormatBlock wsS, "Z1", "E"
        CreateInvoicesFromShipments out
    End If
    WriteBlock wsO, o, "A1"
    FormatBlock wsO, "A1", "E"
End Sub

Private Sub CreateInvoicesFromShipments(ship As Variant)
    Dim wsO As Worksheet: Set wsO = Worksheets("Orders")
    Dim o As Variant: o = ReadRegion(wsO)

    Dim wsInv As Worksheet: Set wsInv = Worksheets("Invoices")
    Dim out() As Variant: ReDim out(1 To 1, 1 To 6)
    out(1, 1) = "InvoiceID": out(1, 2) = "InvoiceDate"
    out(1, 3) = "CustomerID": out(1, 4) = "OrderID": out(1, 5) = "Amount": out(1, 6) = "Status"

    Dim rows As Long: rows = 1
    Dim i As Long
    For i = 2 To UBound(ship, 1)
        ' 金額はOrdersの単価列がない前提なので簡易に数量×仮単価（実務は単価列を参照）
        Dim orderId As String: orderId = CStr(ship(i, 3))
        Dim r As Long
        For r = 2 To UBound(o, 1)
            If CStr(o(r, 1)) = orderId Then
                rows = rows + 1: ReDim Preserve out(1 To rows, 1 To 6)
                out(rows, 1) = "INV-" & Format(Now, "yyyymmdd") & "-" & Format(rows - 1, "000")
                out(rows, 2) = Format(Date, "yyyy-mm-dd")
                out(rows, 3) = o(r, 3)
                out(rows, 4) = orderId
                out(rows, 5) = ToNumberOrZero(o(r, 5)) * 1000 ' 仮単価=1000（例）
                out(rows, 6) = "Draft"
                Exit For
            End If
        Next
    Next
    If rows > 1 Then
        WriteBlock wsInv, out, "Z1"
        FormatBlock wsInv, "Z1", "E"
    End If
End Sub
VB

重要ポイントの深掘り

入庫が来たら在庫とPOステータスを即更新→再引当→出荷・請求へ。ステータス遷移を“一方向”に保つと整合性が保たれます。請求は本来単価・税区分を持ちますが、テンプレでは流れ確認用の仮単価でまず運用を固め、後で単価列・税計算テンプレに接続します。

ダッシュボードと警告：不足・納期遅延・受注停滞の見える化

KPIレポートの生成

' ModOM_Report.bas
Option Explicit

Public Sub BuildOMDashboard()
    Dim wsO As Worksheet: Set wsO = Worksheets("Orders")
    Dim wsP As Worksheet: Set wsP = Worksheets("POs")
    Dim wsI As Worksheet: Set wsI = Worksheets("Inventory")

    Dim o As Variant: o = ReadRegion(wsO)
    Dim p As Variant: p = ReadRegion(wsP)
    Dim inv As Variant: inv = ReadRegion(wsI)

    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets("OM_Dashboard"): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = "OM_Dashboard" Else ws.Cells.Clear

    ' 受注ステータス件数
    Dim cntNew As Long, cntAlloc As Long, cntShip As Long, cntInv As Long
    Dim r As Long
    For r = 2 To UBound(o, 1)
        Select Case LCase$(CStr(o(r, 7)))
            Case "new": cntNew = cntNew + 1
            Case "allocated": cntAlloc = cntAlloc + 1
            Case "shipped": cntShip = cntShip + 1
            Case "invoiced": cntInv = cntInv + 1
        End Select
    Next

    ws.Range("A1").Value = "受注ステータス"
    ws.Range("A2").Resize(4, 2).Value = Array(Array("New", cntNew), Array("Allocated", cntAlloc), Array("Shipped", cntShip), Array("Invoiced", cntInv))

    ' 在庫アラート（補充点以下）
    Dim out() As Variant: ReDim out(1 To 1, 1 To 3)
    out(1, 1) = "ProductID": out(1, 2) = "Current": out(1, 3) = "ReorderPoint"
    Dim rows As Long: rows = 1
    For r = 2 To UBound(inv, 1)
        Dim cur As Double: cur = ToNumberOrZero(inv(r, 3))
        Dim rp As Double: rp = ToNumberOrZero(inv(r, 5))
        If cur <= rp Then
            rows = rows + 1: ReDim Preserve out(1 To rows, 1 To 3)
            out(rows, 1) = inv(r, 1): out(rows, 2) = cur: out(rows, 3) = rp
        End If
    Next
    If rows > 1 Then ws.Range("D1").Resize(rows, 3).Value = out

    ' 発注未受領件数
    Dim pending As Long
    For r = 2 To UBound(p, 1): If LCase$(CStr(p(r, 7))) = "ordered" Then pending = pending + 1
    Next
    ws.Range("G1").Value = "発注未受領": ws.Range("G2").Value = pending

    FormatBlock ws, "A1"
End Sub
VB

重要ポイントの深掘り

KPIは「件数・不足・未受領」を定番に。補充点以下の一覧をそのまま仕入先連絡に使える見た目に整えます。ステータス件数を毎朝確認する運用にすると、滞留や詰まりを早期に発見できます。

例題の通し方：受注→引当→不足発注→入庫→再引当→出荷→請求→ダッシュボード

パイプライン実行例

' ModOM_Example.bas
Option Explicit

Public Sub Run_OrderManagementFlow()
    ' 1) 受注引当
    AllocateOrders
    ' 2) 入庫（Receiptsにデータがある前提で在庫更新）
    ApplyReceipts
    ' 3) 再引当→出荷→請求起票
    ReallocateAndShip
    ' 4) ダッシュボード更新
    BuildOMDashboard
    MsgBox "受発注管理フローが完了しました。", vbInformation
End Sub
VB

期待動作の確認ポイント

受注に“Allocated”が付き、在庫“引当済”が増え、不足があればPOが起票されます。入庫後に現在庫が増え、POは“Received”。再引当で出荷・請求の起票が進み、ダッシュボードにKPIとアラートが表示されます。

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

キー揺らぎで在庫・受注が結びつかない

NormKey（Trim＋LCase）を両側に適用し、商品ID・顧客IDのぶれを根絶します。

引当済の管理を省いて二重出荷が起きる

現在庫と引当済を分離し、引当のたびに“引当済”を更新。在庫の見かけ値と実質残を分けるのが鉄則です。

部分引当の扱いが曖昧

可能なら部分引当して不足分を明示的に集計。ステータスは“New”のままにして、再引当の対象に残します。

発注の仕入先決定が属人化

商品→仕入先のルールを関数化（Masterテーブル化）し、誰が回しても同じ結果に。

価格・税の未定義で請求金額が不正確

フロー先行で「請求起票の型」を固め、後から単価列・税計算テンプレ（請求書自動生成）を接続すると安全に拡張できます。

セル逐次書きで遅い

結果は配列で作り、一括書き戻し。10万行でもUIが固まりません。

まとめ：ステータス遷移と在庫引当の型で、受発注を“壊れない流れ”にする

受注→在庫引当→不足発注→入庫→再引当→出荷→請求までを、一方向のステータス遷移と“現在庫・引当済”の二段管理で統一します。不足集計から発注起票まで自動化すれば、毎日の判断を標準化できます。

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