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, s

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

'首先检查是否有BOM

Set d = CreateObject("scripting.dictionary")
arr = Sheets("BOM").UsedRange
brr = Sheets("Update").UsedRange


For i = 2 To UBound(arr)
    s = arr(i, 1)
    d(s) = i
Next

For i = 2 To UBound(brr)
    If Not d.exists(brr(i, 1)) Then
    MsgBox "这个SKU没有BOM，请检查BOM或者SKU书写！" & vbLf & vbLf & "第" & i & "行", vbOKCancel
    Exit Sub
    End If
Next

Debug.Print UBound(brr), UBound(brr, 2)

d.RemoveAll
'先把Update的东西存在数组中
m = 0
For i = 1 To UBound(brr)
  
  s = brr(i, 1)
  If d(s) = "" Then
    m = m + 1
    d(s) = m
    For j = 1 To UBound(brr, 2)
        ReDim Preserve crr(1 To UBound(brr, 2), 1 To m)
        crr(j, m) = brr(i, j)
    Next
  Else
    For j = 2 To UBound(brr, 2)
        crr(j, d(s)) = crr(j, d(s)) + Val(brr(i, j))
    Next
  End If
  
Next

drr = 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 = 0
    For i = 1 To UBound(drr)
    
        For j = 2 To UBound(arr)
            If drr(i, 1) = arr(j, 1) Then
                s = CStr(arr(j, 2))
                If d(s) = "" Then
                    m = m + 1
                    d(s) = m
                    ReDim Preserve brr(1 To UBound(drr, 2), 1 To m)
                    brr(1, m) = s
                    For k = 2 To UBound(drr, 2)
                        brr(k, m) = drr(i, k) * arr(j, 3)
                    Next
                Else
                For k = 2 To UBound(drr, 2)
                    brr(k, d(s)) = brr(k, d(s)) + drr(i, k) * arr(j, 3)
                Next
                End If
            End If
        Next
    Next
    
Sheets("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) Then
    n = n + 1
    ReDim Preserve da(1 To n)
    da(n) = j
    Exit For
    End If
    Next
Next

d.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) Then
            For k = 1 To UBound(da)
                Sheets("Material").Cells(j, da(k)) = Sheets("Material").Cells(j, da(k)) + drr(i, k + 1)
                '这是数据，不是单元格，所以无法直接显示出来
                'Debug.Print "allen"
            Next
        ElseIf Not d.exists(drr(i, 1)) Then
            m = m + 1
            Sheets("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)
            Next
            GoTo Allen
        End If
    Next
Allen:
Next

Debug.Print j

End Sub