BOM成本计算（有偿求助大神）

microyip

今天因为给论坛里关于BOM的写了个代码，回头看这个贴，也补一下

1. Private vData As Variant, nRow As Long, nCol As Long
   
2. Private dicItem As Object, dicParent As Object
   
3. 
   
4. Sub BOM统计()
   
5.     Dim nVal As Double, vItem As Variant
   
6.    
   
7.     Application.ScreenUpdating = False
   
8.     Set dicItem = CreateObject("Scripting.Dictionary") 'BOM表项目值
   
9.     Set dicParent = CreateObject("Scripting.Dictionary") 'BOM表子项对应的父项
   
10.     With Sheet1
    
11.         nRow = .Cells(.Rows.Count, 2).Row
    
12.         vData = .[A2:B2].Resize(nRow - 1, 5).Value
    
13.         ReDim Preserve vData(1 To UBound(vData), 1 To 5 + 1) '扩展一列记录子项总列表
    
14.         For nRow = 1 To UBound(vData)
    
15.             If vData(nRow, 2) <> "" Then
    
16.                 If UBound(vData, 2) - 6 < vData(nRow, 1) + 1 Then '记录子项值层数不足
    
17.                     ReDim Preserve vData(1 To UBound(vData), 1 To 6 + vData(nRow, 1) + 1)
    
18.                 End If
    
19.                 For nCol = 0 To vData(nRow, 1) '记录各层子项
    
20.                     If nCol <> vData(nRow, 1) Then
    
21.                         vData(nRow, 7 + nCol) = vData(nRow - 1, 7 + nCol)
    
22.                     Else
    
23.                         vData(nRow, 7 + nCol) = vData(nRow, 2)
    
24.                     End If
    
25.                     If vData(nRow, 6) <> "" Then vData(nRow, 6) = vData(nRow, 6) & "|"
    
26.                     vData(nRow, 6) = vData(nRow, 6) & vData(nRow, 7 + nCol)
    
27.                 Next
    
28.                 SetDic
    
29.             End If
    
30.         Next
    
31.         
    
32.         For Each vItem In dicItem.Keys
    
33.             Do While dicParent.Exists(vItem)
    
34.                 nVal = dicItem(vItem)("用量") * dicItem(vItem)("单价")
    
35.                 vItem = dicParent(vItem)
    
36.                 If Not dicItem.Exists(vItem) Then
    
37.                     Set dicItem(vItem) = CreateObject("Scripting.Dictionary")
    
38.                     dicItem(vItem)("用量") = 1
    
39.                 End If
    
40.                 dicItem(vItem)("单价") = dicItem(vItem)("单价") + nVal
    
41.             Loop
    
42.         Next
    
43.         For nRow = 1 To UBound(vData)
    
44.             vItem = Trim(vData(nRow, 6))
    
45.             If vItem <> "" Then
    
46.                 vData(nRow, 4) = dicItem(vItem)("单价")
    
47.                 vData(nRow, 5) = (dicItem(vItem)("用量") - 1 * (dicItem(vItem)("用量") = 0)) * dicItem(vItem)("单价")
    
48.             End If
    
49.         Next
    
50.         .[A2:E2].Resize(UBound(vData), 5) = vData
    
51.     End With
    
52.     Application.ScreenUpdating = True
    
53. End Sub
    
54. 
    
55. Private Function SetDic(Optional ByVal Level As Long = 7, Optional ByVal Parent As Variant = Empty)
    
56.     Dim vKey As Variant, vSon As Variant
    
57.    
    
58.     vKey = vData(nRow, Level) '如果是第7列，则为顶父级
    
59.    
    
60.     If Parent <> "" Then vSon = Parent & "|"
    
61.     vSon = vSon & vKey
    
62.     If Parent <> "" Then dicParent(vSon) = Parent
    
63.    
    
64.     If Level - 7 = vData(nRow, 1) Then
    
65.         Set dicItem(vSon) = CreateObject("Scripting.Dictionary")
    
66.         dicItem(vSon)("用量") = Val(vData(nRow, 3))
    
67.         dicItem(vSon)("单价") = Val(vData(nRow, 4))
    
68.     Else
    
69.         If dicItem.Exists(vSon) Then If dicItem(vSon).Exists("单价") Then dicItem(vSon).Remove "单价"
    
70.         SetDic Level:=Level + 1, Parent:=vSon
    
71.     End If
    
72. End Function

复制代码

microyip

附上附件以供参考

fjlhgs

用递归做了一下

longtou5505

飞天篮球猪 发表于 2020-6-20 11:47
提供一个Power Query 解法, 供参考...
20万行数据效率没有问题.....Revised

Mark一下，计算汇总用

382273844

这个得详细说要求了，就这三两句话是搞不定BOM的

chengshanming

楼主所举的例子本身就有问题的，同一半成品编码，在同一BOM中反复出现，同一层级不同的结构。如果只考虑层级结构，所有的代码是可以用的，如果结合物料编码（一物一码）的，这个就有问题了。

杨水清

可以更加系统的核算成本。