MRP(VBA系列):7.Demand vs Supply

这个是比较直观的分析，可以看到每天的需求，到货，当天的剩余。

这里可以应用到很多地方，我之前也将这个方法适用到客户订单的管理上，成品库存，产出计划，发货计划，剩余库存！

Tips：所有代码都是为目前任职公司编写，极大概率不适合其他公司，在这里发布：首先是记录；其次才是分享，望理解！.

思维导图：

代码：

Sub SDB()

'需要用到的sheet：Stock（库存），database（供应商），demand（每日需求）PO（交货），
'难点：每日需求：直接复制？可以
'交货：需要用到字典，nrr（1，j)&item=d.exists(item)?

Dim arr, brr, crr, drr, err, frr(), grr()
Dim d As New Dictionary
Dim i, j, k, m, n
Dim str

arr = Sheets("Stock").UsedRange
'brr = Sheets("BOM").UsedRange不需要了，因为我写的Demand本身就有这个
crr = Sheets("Database").UsedRange
drr = Sheets("Demand").UsedRange
err = Sheets("PO").UsedRange

ReDim frr(1 To (UBound(drr) - 1) * 4 + 1, 1 To UBound(drr, 2) + 2)

'先把第一行处理好
frr(1, 1) = "Item"
frr(1, 2) = "Line down"
frr(1, 3) = "Inv."
frr(1, 4) = "DSB"

For i = 3 To UBound(drr, 2)
    frr(1, i + 2) = drr(1, i)
Next

'库存数据做字典和数组经典汇总
str = ""
For i = 2 To UBound(arr)
    str = CStr(arr(i, 1))
    If Not d.Exists(str) Then
        d(str) = arr(i, 2)
    Else
        d(str) = d(str) + arr(i, 2)
    End If
Next


str = ""
For i = 2 To UBound(err)
    str = CStr(err(i, 1)) & Format(err(i, 4), "yyyy-mm-dd")
    If Not d.Exists(str) Then
        d(str) = err(i, 5)
    Else
        d(str) = d(str) + err(i, 5)
    End If
Next

   
'Sheets("test").[a1].Resize(UBound(frr), UBound(frr, 2)) = frr
n = 1
str = ""
For i = 2 To UBound(drr)
    For j = 1 To 4
        Select Case j
            Case Is = 1
            '处理第一行
                n = n + 1
                frr(n, 1) = drr(i, 1)
                frr(n, 4) = "Demand"
                For m = 3 To UBound(drr, 2)
                    frr(n, m + 2) = drr(i, m)
                Next
                If d.Exists(CStr(drr(i, 1))) Then
                    frr(n, 3) = d(CStr(drr(i, 1)))
                Else
                    frr(n, 3) = 0
                End If
                
            Case Is = 2
            '处理第二行
                n = n + 1
                frr(n, 2) = drr(i, 2)
                frr(n, 4) = "Supply"
                For m = 2 To UBound(crr)
                    If drr(i, 1) = crr(m, 1) Then
                    frr(n, 1) = crr(m, 2)
                    End If
                Next
                For m = 5 To UBound(frr, 2)
                    str = CStr(drr(i, 1) & Format(frr(1, m), "yyyy-mm-dd"))
                    If d.Exists(str) Then
                        frr(n, m) = d(str)
                    Else
                        frr(n, m) = 0
                    End If
                Next

            Case Is = 3
            '处理第三行
                n = n + 1
                frr(n, 4) = "Balance"
                For m = 5 To UBound(frr, 2)
                    If m = 5 Then
                    frr(n, 5) = Format(frr(n - 2, 3) + frr(n - 1, 5) - frr(n - 2, 5), "#0.00")
                    Else
                    frr(n, m) = Format(frr(n, m - 1) + frr(n - 1, m) - frr(n - 2, m), "#0.00")
                    End If
                Next
                For m = 5 To UBound(frr, 2)
                    If frr(n, m) < 0 Then
                        frr(n - 2, 2) = frr(1, m)
                        Exit For
                    'ElseIf m = UBound(frr, 2) + 1 Then，虽然m会到ubound+1,但是不会进入循环了
                        'frr(n - 2, 2) = "Non-Shortage"
                    End If
                Next
                If m = UBound(frr, 2) + 1 And frr(n, m - 1) >= 0 Then
                    frr(n - 2, 2) = "Non-shortage"
                End If
            Case Is = 4
            '没有什么需要处理的
                n = n + 1
                
        End Select
    Next
Next


'先把Title放入grr
m = 1
ReDim Preserve grr(1 To UBound(frr, 2), 1 To m)
For i = 1 To UBound(frr, 2)
    grr(i, m) = frr(1, i)
Next

For i = 2 To UBound(frr) Step 4
    If frr(i, 2) <> "Non-shortage" Then
        For j = 0 To 3
            m = m + 1
            ReDim Preserve grr(1 To UBound(frr, 2), 1 To m)
            For k = 1 To UBound(frr, 2)
                grr(k, m) = frr(i + j, k)
            Next
        Next
    End If
Next

Sheets("test").Rows("2:1048576").Delete

Sheets("test").[a:a].NumberFormatLocal = "@"

'Sheets("test").[a1].Resize(UBound(grr, 2), UBound(grr)) = Application.Transpose(grr)
Sheets("test").[a1].Resize(UBound(frr), UBound(frr, 2)) = frr