Discoverer导出的多层BOM如何拼装为能够直接体现采购层的单层BOM？

Discoverer导出的多层BOM如何转为能够直接体现采购层的单层BOM？

这个标题可能有点拗口！

我们发现Discoverer导出的FG零件清单，只有第一层。

第一层的每个Phantom件又有其它Purchased Item，Reference Item，Phantom....

第二层，第三层也是如此。但是工作中我们需要一份Excel的物料Forecast，制作这份Forecast可以从Discrete Job中建立，马上取消方式得到采购层的BOM。一个一个的操作显然有点浪费时间，最后，我决定用VBA来重组Discoverer数据，这些都是供应链需要

具体步骤

一、固定格式，以后每次使用这个VBA都要遵守此格式。

1.1，Sheets（“BOM”）格式：

1.2，Sheets（“FC”）格式：

1.3，假设最终层为4层，Layer1，Layer2，Layer3都是过渡的Sheet，所以不做Title设定，Layer4格式：

二、VBA代码部分：

2.1，建立FG下的BOM提取，代码：

Sub FG_layer()Dim i, j, k As Integer
Dim c As Range
k = 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Layer_1"
For i = 1 To Sheets("FC").UsedRange.Rows.CountFor Each c In Sheets("BOM").Range("A:A")If c = Sheets("FC").Cells(i, 1) ThenSheets("BOM").Rows(c.Row).Copy Sheets("layer_1").Rows(k)k = k + 1End IfNext c
Next i
End Sub

2.2，建立Layer1下的BOM，把Layer1下的物料清单从BOM中提取出来：

错误记录：if A<>B then statement, Else出错，因为这个else的符合的条件太多，建议使用Elseif condition

Sub Layer_1()'we have found all the layer1 under FG SKU, now we need to find all sub-layer under Layer1
Dim i, j, k As Integer
Dim c As Rangek = 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Layer_2"For i = 1 To Sheets("Layer_1").UsedRange.Rows.CountIf Sheets("Layer_1").Cells(i, 4) <> "Phantom item" ThenSheets("layer_2").Cells(k, 1) = Sheets("Layer_1").Cells(i, 1)Sheets("layer_2").Cells(k, 3) = Sheets("Layer_1").Cells(i, 2)Sheets("layer_2").Cells(k, 4) = Sheets("Layer_1").Cells(i, 3)Sheets("layer_2").Cells(k, 5) = Sheets("Layer_1").Cells(i, 4)k = k + 1ElseIf Sheets("Layer_1").Cells(i, 4) = "Phantom item" ThenFor Each c In Sheets("BOM").Range("A:A")If c = Sheets("Layer_1").Cells(i, 2) ThenSheets("layer_2").Cells(k, 1) = Sheets("Layer_1").Cells(i, 1)Sheets("layer_2").Cells(k, 2) = cSheets("layer_2").Cells(k, 3) = c.Offset(0, 1)Sheets("layer_2").Cells(k, 4) = c.Offset(0, 2) * Sheets("Layer_1").Cells(i, 3)Sheets("layer_2").Cells(k, 5) = c.Offset(0, 3)k = k + 1End IfNext cEnd If
Next i
End Sub

三、把第二层下的子件也提取出来，If c = Sheets("Layer_2").Cells(i, 3)，就是永远都是把最新的层为依据去总BOM中查找。

Sub Layer_2()
Dim i, j, k As Integer
Dim c As Rangek = 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Layer_3"For i = 1 To Sheets("Layer_2").UsedRange.Rows.CountIf Sheets("Layer_2").Cells(i, 5) <> "Phantom item" Then   Sheets("layer_3").Cells(k, 1) = Sheets("Layer_2").Cells(i, 1)Sheets("layer_3").Cells(k, 4) = Sheets("Layer_2").Cells(i, 3)Sheets("layer_3").Cells(k, 5) = Sheets("Layer_2").Cells(i, 4)Sheets("layer_3").Cells(k, 6) = Sheets("Layer_2").Cells(i, 5)          k = k + 1    ElseIf Sheets("Layer_2").Cells(i, 5) = "Phantom item" Then    For Each c In Sheets("BOM").Range("A:A")If c = Sheets("Layer_2").Cells(i, 3) ThenSheets("layer_3").Cells(k, 1) = Sheets("Layer_2").Cells(i, 1)Sheets("layer_3").Cells(k, 2) = Sheets("Layer_2").Cells(i, 2)Sheets("layer_3").Cells(k, 3) = cSheets("layer_3").Cells(k, 4) = c.Offset(0, 1)Sheets("layer_3").Cells(k, 5) = c.Offset(0, 2) * Sheets("Layer_2").Cells(i, 4)Sheets("layer_3").Cells(k, 6) = c.Offset(0, 3)        k = k + 1        End IfNext cEnd IfNext i
End Sub

四、同理，把第三层下Phantom的子件提取出来，没有子件的purchased、Reference就直接拷贝到新的Sheet中：

Sub layer_3()Dim i, j, k As Integer
Dim c As Rangek = 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Layer_4"For i = 1 To Sheets("Layer_3").UsedRange.Rows.CountIf Sheets("Layer_3").Cells(i, 6) <> "Phantom item" ThenSheets("layer_4").Cells(k, 1) = Sheets("Layer_3").Cells(i, 1)Sheets("layer_4").Cells(k, 5) = Sheets("Layer_3").Cells(i, 4)Sheets("layer_4").Cells(k, 6) = Sheets("Layer_3").Cells(i, 5)Sheets("layer_4").Cells(k, 7) = Sheets("Layer_3").Cells(i, 6)k = k + 1ElseIf Sheets("Layer_3").Cells(i, 6) = "Phantom item" ThenFor Each c In Sheets("BOM").Range("A:A")If c = Sheets("Layer_3").Cells(i, 4) ThenSheets("layer_4").Cells(k, 1) = Sheets("Layer_3").Cells(i, 1)Sheets("layer_4").Cells(k, 2) = Sheets("Layer_3").Cells(i, 2)Sheets("layer_4").Cells(k, 3) = Sheets("Layer_3").Cells(i, 3)Sheets("layer_4").Cells(k, 4) = cSheets("layer_4").Cells(k, 5) = c.Offset(0, 1)Sheets("layer_4").Cells(k, 6) = c.Offset(0, 2) * Sheets("Layer_3").Cells(i, 5)Sheets("layer_4").Cells(k, 7) = c.Offset(0, 3)k = k + 1End IfNext cEnd IfNext iSheets("layer_4").Rows(1).InsertSheets("layer_4").Cells(1, 1) = "FG"Sheets("layer_4").Cells(1, 2) = "Layer1"Sheets("layer_4").Cells(1, 3) = "Layer2"Sheets("layer_4").Cells(1, 4) = "Layer3"Sheets("layer_4").Cells(1, 5) = "Layer4"Sheets("layer_4").Cells(1, 6) = "Usage"Sheets("layer_4").Cells(1, 7) = "Item_Type"End Sub

五、最后，我们用一个Sub S_total把上文的四个Sub按先后顺序汇总起来，以后只要直接使用S_Total过程就可以了。

注意事项：

1，因为没有加入Error处理语句（懒），所以必须保证每个物料的Item Type都是有参数的，不能是#N/A，不然报错

2，运行完第四个Sub之后，Layer_4的清单中item Type应该只有Purchase和Reference

3，没有加入Subassembly（需要单独建工单的Item，如果需要加入，可以考虑与Phantom同属性，至少在采购，物料计划这个领域可以这样认为）