MRP(VBA系列):2.实现BOM和PLAN的乘法运算

简单说，就是实现将生产计划转为更为详细的物料每日需求计划：

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

代码：

Sub REQ()

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

'将有出现在Plan中的BOM存放在新的数组中
'从新数组的第五列开始存放”待包装“至最后日期的BOM*REQ数量

Application.ScreenUpdating = False


arr = Sheets("Plan").UsedRange
brr = Sheets("BOM").UsedRange

k = 0
str = ""
For i = 2 To UBound(arr)
    str = CStr(arr(i, 2))
    If Not d.Exists(str) Then
        k = k + 1
        d(str) = k
        ReDim Preserve err(1 To UBound(arr, 2) - 5, 1 To k)
        err(1, k) = str
        For j = 2 To UBound(arr, 2) - 6
            err(j, k) = arr(i, j + 5)
        Next
    Else
        For j = 2 To UBound(arr, 2) - 6
            err(j, d(str)) = err(j, d(str)) + arr(i, j + 5)
        Next
    End If
Next
Debug.Print UBound(arr), UBound(arr, 2)
Debug.Print UBound(err), UBound(err, 2)
'Sheets("test").[a1].Resize(UBound(err, 2), UBound(err)) = Application.Transpose(err)

str = ""
k = 0
For i = 2 To UBound(brr)
    str = CStr(brr(i, 1))
    If d.Exists(str) Then
        k = k + 1
        ReDim Preserve crr(1 To 4, 1 To k)
        For j = 1 To 4
            crr(j, k) = brr(i, j)
        Next
    End If
Next

'Sheets("test").[a1].Resize(UBound(crr, 2), UBound(crr)) = Application.Transpose(crr)
ReDim drr(1 To UBound(crr, 2), 1 To 4)
For i = 1 To UBound(crr)
    For j = 1 To UBound(crr, 2)
        drr(j, i) = crr(i, j)
    Next
Next

'Sheets("test").[a1].Resize(UBound(crr, 2), UBound(crr)) = drr


ReDim Preserve drr(1 To UBound(drr), 1 To UBound(arr, 2) - 6 + 4)
str = ""
For i = 1 To UBound(drr)
    str = CStr(drr(i, 1))
    For j = 2 To UBound(err)
        drr(i, j + 3) = drr(i, 3) * err(j, d(str)) * (drr(i, 4) + 1)
    Next
Next

m = Sheets("Plan").[a1].End(xlToRight).Address
n = Mid(m, 2, InStrRev(m, "$") - 2)
tt1 = Sheets("BOM").Range("A1:D1")
tt2 = Sheets("Plan").Range("G1:" & n & 1)

Sheets("REQ").Cells.Clear
Sheets("REQ").Activate
[d2].Select
ActiveWindow.FreezePanes = True
Sheets("REQ").[a:b].NumberFormatLocal = "@"
Sheets("REQ").[1:1].NumberFormatLocal = "m/d"
Sheets("REQ").[a1].Resize(1, UBound(tt1, 2)) = tt1
Sheets("REQ").[e1].Resize(1, UBound(tt2, 2)) = tt2
'Debug.Print m, n
Sheets("REQ").[a2].Resize(UBound(drr), UBound(drr, 2)) = drr

'Debug.Print UBound(drr), UBound(drr, 2)


End Sub

以上代码，需要配合单层BOM，我在的公司，本人已经完成过单层BOM的重组公式，目前是下沉至第六层！