VBA:新增某个月的FC至Excel版物料Forecast

Background：

公司的经营是不断变化的，通常我们在月初会收到一份FC，但是在这之后，FC会不停的变化：增加，取消，减少数量，所以系统之外的Forecast也需要快速更新。

Logic：

1，BOM需要使用包含全部设备的BOM，使用单层BOM，如何获得单层BOM，请参考之前的思路的代码（有时间我会把数组和字典版本的也更新一下）。

2，增加：我们把BOM对应的数量，每个月份和数量都存放在一个二维数组中

>如果是已有的Item，那么就累加到“物料FC”中

>如果是没有的Item，那么就新增“物料FC”的最后

3，取消/减少数量：我们使用负数来表示删除或者取消，直接在FG的时候就区分出来，然后在“物料FC"中逐行读取，找到之后，也是用累加负数方式更新”物料FC“

测试：

1，我们先挑选两个SKU，在7月和8月的时候各增加50台，把FC这个Sheet的标题，直接Copy到Update sheet（每次更新在这个表格中填写），这里不用数组了，使用下文代码就可以了。

Sheets("FC").Rows(1).Copy Sheets("Update").Rows(1)

（图一：FC和Update的title一致）

2，建立以下几个worksheet

3，代码如下：

Sub FC_update()Dim arr, brr, crr(), drr, da(), fn
Dim i, j, k, m, n, sSheets("FC").Rows(1).Copy Sheets("Update").Rows(1)'首先检查是否有BOMSet d = CreateObject("scripting.dictionary")
arr = Sheets("BOM").UsedRange
brr = Sheets("Update").UsedRangeFor i = 2 To UBound(arr)s = arr(i, 1)d(s) = i
NextFor i = 2 To UBound(brr)If Not d.exists(brr(i, 1)) ThenMsgBox "这个SKU没有BOM，请检查BOM或者SKU书写！" & vbLf & vbLf & "第" & i & "行", vbOKCancelExit SubEnd If
NextDebug.Print UBound(brr), UBound(brr, 2)d.RemoveAll
'先把Update的东西存在数组中
m = 0
For i = 1 To UBound(brr)s = brr(i, 1)If d(s) = "" Thenm = m + 1d(s) = mFor j = 1 To UBound(brr, 2)ReDim Preserve crr(1 To UBound(brr, 2), 1 To m)crr(j, m) = brr(i, j)NextElseFor j = 2 To UBound(brr, 2)crr(j, d(s)) = crr(j, d(s)) + Val(brr(i, j))NextEnd IfNextdrr = Application.Transpose(crr)Debug.Print UBound(drr), UBound(drr, 2)'On Error Resume Next
d.RemoveAll
Erase arr, brr
'从BOM中找到所有对应的BOM
'先看看transpose后的drr的开始上下标,坐标以brr（1,1）开始
'Debug.Print drr(2, 1)
arr = Sheets("BOM").UsedRange
m = 0For i = 1 To UBound(drr)For j = 2 To UBound(arr)If drr(i, 1) = arr(j, 1) Thens = CStr(arr(j, 2))If d(s) = "" Thenm = m + 1d(s) = mReDim Preserve brr(1 To UBound(drr, 2), 1 To m)brr(1, m) = sFor k = 2 To UBound(drr, 2)brr(k, m) = drr(i, k) * arr(j, 3)NextElseFor k = 2 To UBound(drr, 2)brr(k, d(s)) = brr(k, d(s)) + drr(i, k) * arr(j, 3)NextEnd IfEnd IfNextNextSheets("sheet2").Cells.Clear
Sheets("sheet2").[a:a].NumberFormatLocal = "@"
drr = Application.Transpose(brr)
Sheets("Sheet2").[a2].Resize(m, UBound(brr)) = drr
Sheets("Update").Rows(1).Copy Sheets("sheet2").Rows(1)'接下来我们开始往Material Forecast中Update对应物料的数量
'Material Forecast中的物料都是唯一的fn = Sheets("Update").Range("B1:H1")
'Debug.Print UBound(fn), UBound(fn, 2)Erase arr
'drr = Application.Transpose(brr)
arr = Sheets("Material").UsedRange
'找到和Update每月相同的列号
n = 0
For i = 1 To UBound(fn, 2)For j = 1 To UBound(arr, 2)If fn(1, i) = arr(1, j) Thenn = n + 1ReDim Preserve da(1 To n)da(n) = jExit ForEnd IfNext
Nextd.RemoveAll
For i = 2 To UBound(arr)s = arr(i, 1)d(s) = ""
Next
'Debug.Print n
'For i = 1 To n
'Debug.Print da(i)
'Next
'接下来我们把brr的数据更新到Material：存放着需要新增的，或者减少的物料数量
m = 0
For i = 1 To UBound(drr)For j = 2 To UBound(arr)If drr(i, 1) = arr(j, 1) ThenFor k = 1 To UBound(da)Sheets("Material").Cells(j, da(k)) = Sheets("Material").Cells(j, da(k)) + drr(i, k + 1)'这是数据，不是单元格，所以无法直接显示出来'Debug.Print "allen"NextElseIf Not d.exists(drr(i, 1)) Thenm = m + 1Sheets("Material").Cells(UBound(arr) + m, 1) = drr(i, 1)For k = 1 To UBound(da)Sheets("Material").Cells(UBound(arr) + m, da(k)) = drr(i, k + 1)NextGoTo AllenEnd IfNext
Allen:
NextDebug.Print jEnd Sub