父件子件关系的BOM表格计算方法之一（蓝桥方法）

蓝桥玄霜

当看到BOM表格的时候，我们大都会觉得眼花缭乱，被那么多的层级搞糊涂了，我不知道他们在实际工作中是怎么计算的，如果手工计算的话，真是需要足够的耐心和毅力。

最近看到有会员来求助，经过一段时间的研究，我找到了一个计算方法，称之为蓝桥方法。希望能够使被这种计算困扰的人们解放出来。

该方法的思路比较简单清晰：

1，  先用字典求得各层级材料所在行的行数；这是容易做到的；

2，  通过下一层级与上一层级的逐级比较，获得各层级材料的上一层级所在的行位置，并且放入另一个字典；

3，  通过不同的计算方法计算成本和工时的汇总。

期待大家提供实例来测试，以便完善计算方法。

1. Public Arr, d, d1, k, t
   
2. Sub lqxs_cbgs0528()
   
3. '适用于加子件本身数量的工时算法
   
4. '适用于不加子件本身数量的成本算法
   
5. 'by:蓝桥玄霜 2013-5-28
   
6. 
   
7. Dim i&, Brr, k2, t2, j&, aa, a, tt2, zjj
   
8. Set d = CreateObject("Scripting.Dictionary")
   
9. Set d1 = CreateObject("Scripting.Dictionary")
   
10. 'Sheet5.Activate
    
11. [i2:l50000] = ""
    
12. Arr = [a1].CurrentRegion
    
13. ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2) - 3)
    
14. For i = 2 To UBound(Arr)
    
15.     d(Arr(i, 1)) = d(Arr(i, 1)) & i & ","
    
16. Next
    
17. k = d.keys: t = d.items
    
18. For i = 0 To UBound(k)
    
19.     If i = 0 Then
    
20.         Call yy0(t(i), i)
    
21.     Else
    
22.         Call yy(t(i), i)
    
23.     End If
    
24. Next
    
25. k2 = d1.keys: t2 = d1.items
    
26. For ii = 4 To UBound(Arr, 2)
    
27. For i = UBound(k2) To 1 Step -1
    
28.     tt2 = Left(t2(i), Len(t2(i)) - 1)
    
29.     If InStr(tt2, "|") Then
    
30.         aa = Split(tt2, "|")
    
31.         For j = 0 To UBound(aa)
    
32.             a = Split(aa(j), ",")
    
33.             If ii <> 4 Then  '计算工时
    
34.                 If Arr(a(0), ii) <> 0 Then
    
35.                     zjj = Arr(a(0), 3) * Arr(a(0), ii)
    
36.                     Brr(a(0), ii - 3) = Brr(a(0), ii - 3) + zjj
    
37.                     Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + Arr(a(2), 3) * Brr(a(0), ii - 3)
    
38.                 Else
    
39.                     Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + Arr(a(2), 3) * Brr(a(0), ii - 3)
    
40.                 End If
    
41.             Else  '计算成本
    
42.                 If Brr(a(0), ii - 3) = 0 Then
    
43.                     zjj = Arr(a(0), 3) * Arr(a(0), ii)
    
44.                 Else
    
45.                     zjj = Brr(a(0), ii - 3)
    
46.                 End If
    
47.                 Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + zjj * Arr(a(2), 3)
    
48.             End If
    
49.         Next
    
50.     End If
    
51. Next
    
52. Brr(1, ii - 3) = Cells(1, ii + 5).Value
    
53. Next
    
54. Cells(1, 9).Resize(UBound(Arr), 4) = Brr
    
55. End Sub
    
56. 
    
57. 
    
58. Public Sub yy(tt, c)
    
59. 'by:蓝桥玄霜 2013-5-28
    
60. Dim k1, t1, t2, j&, aa, sj, gs, i&, bb
    
61. t1 = Left(t(c - 1), Len(t(c - 1)) - 1)
    
62. t2 = Left(tt, Len(tt) - 1)
    
63. If InStr(t2, ",") Then
    
64.     bb = Split(t2, ",")
    
65.     For j = 0 To UBound(bb)
    
66.         If InStr(t1, ",") Then
    
67.             aa = Split(t1, ",")
    
68.             For i = UBound(aa) To 0 Step -1
    
69.                 If Val(bb(j)) > Val(aa(i)) Then
    
70.                     sj = aa(i): gs = Arr(bb(j), 3)
    
71.                     d1(k(c)) = d1(k(c)) & bb(j) & "," & gs & "," & sj & "|"
    
72.                     Exit For
    
73.                 End If
    
74.             Next
    
75.         Else
    
76.             sj = t1: gs = Arr(bb(j), 3)
    
77.             d1(k(c)) = d1(k(c)) & bb(j) & "," & gs & "," & sj & "|"
    
78.         End If
    
79.     Next
    
80. Else
    
81.     gs = Arr(t2, 3): sj = t2 - 1
    
82.     d1(k(c)) = d1(k(c)) & t2 & "," & gs & "," & sj & "|"
    
83. End If
    
84. End Sub
    
85. Public Sub yy0(tt, c)
    
86. 'by:蓝桥玄霜 2013-5-28
    
87. Dim t1, bb, j&, sj, gs
    
88. t1 = Left(tt, Len(tt) - 1)
    
89. If InStr(t1, ",") Then
    
90.     bb = Split(t1, ",")
    
91.     For j = 0 To UBound(bb)
    
92.         sj = bb(j): gs = Arr(bb(j), 3)
    
93.         d1(k(c)) = d1(k(c)) & bb(j) & "," & gs & "," & sj & "|"
    
94.     Next
    
95. Else
    
96.     gs = Arr(t1, 3): sj = t1
    
97.     d1(k(c)) = d1(k(c)) & t1 & "," & gs & "," & sj & "|"
    
98. End If
    
99. End Sub
    

复制代码

该贴已经同步到 蓝桥玄霜的微博

蓝桥玄霜

BOM蓝桥方法0531.rar (36.32 KB, 下载次数: 2316)

2013-5-31 21:09 上传

点击文件名下载附件

请见附件。

lzqlaj

蓝桥老师的作品，下载收藏了，谢谢分享。

cnh6226

多谢蓝版，手工验算一个简单BOM，正是想要的数据！！

EH2003

蓝桥老师的作品，下载收藏了，谢谢分享。

cnh6226

蓝桥玄霜 发表于 2013-5-29 10:32
请见附件。

蓝版，在你的表里，我放入我一个产品的实际数据，进行了测试，结果是

第一行出不来数据

另手工验算了“BOM2-测试工作表”一部分
K101,我认为应该有数值，为30。
J199,应为34＝23+11
K199应为180＝126+54

BOM蓝桥方法0528测试.rar (54.42 KB, 下载次数: 129)

2013-5-30 23:50 上传

点击文件名下载附件

再再有，如何增加列——我还有Z1机器、Z2机器……也要对其工时进行汇总{:soso_e127:}

蓝桥玄霜

BOM2只有93行，怎么有>100行的数据？是不是附件上传错了？
建议上传附件我来测试。

cnh6226

蓝桥玄霜 发表于 2013-5-31 13:20
BOM2只有93行，怎么有>100行的数据？是不是附件上传错了？
建议上传附件我来测试。

我晕死，传错附件了！

cnh6226

蓝桥玄霜 发表于 2013-5-31 13:20
BOM2只有93行，怎么有>100行的数据？是不是附件上传错了？
建议上传附件我来测试。

蓝版，附件重传了。
BOM蓝桥方法0528-测试2.rar (36.79 KB, 下载次数: 182)

2013-5-31 16:31 上传

点击文件名下载附件

蓝桥玄霜

1. Public Arr, d, d1, k, t
   
2. Sub lqxs_cbgs0528()
   
3. '适用于加子件本身数量的工时算法
   
4. '适用于不加子件本身数量的成本算法
   
5. 'by:蓝桥玄霜 2013-5-28
   
6. 
   
7. Dim i&, Brr, k2, t2, j&, aa, a, tt2, zjj
   
8. Set d = CreateObject("Scripting.Dictionary")
   
9. Set d1 = CreateObject("Scripting.Dictionary")
   
10. 'Sheet5.Activate
    
11. [i2:l50000] = ""
    
12. Arr = [a1].CurrentRegion
    
13. ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2) - 3)
    
14. For i = 2 To UBound(Arr)
    
15.     d(Arr(i, 1)) = d(Arr(i, 1)) & i & ","
    
16. Next
    
17. k = d.keys: t = d.items
    
18. For i = 0 To UBound(k)
    
19.     If i = 0 Then
    
20.         Call yy0(t(i), i)
    
21.     Else
    
22.         Call yy(t(i), i)
    
23.     End If
    
24. Next
    
25. k2 = d1.keys: t2 = d1.items
    
26. For ii = 4 To UBound(Arr, 2)
    
27. For i = UBound(k2) To 1 Step -1
    
28.     tt2 = Left(t2(i), Len(t2(i)) - 1)
    
29.     If InStr(tt2, "|") Then
    
30.         aa = Split(tt2, "|")
    
31.         For j = 0 To UBound(aa)
    
32.             a = Split(aa(j), ",")
    
33.             If ii <> 4 Then  '计算工时
    
34.                 If Arr(a(0), ii) <> 0 Then
    
35.                     zjj = Arr(a(0), 3) * Arr(a(0), ii)
    
36.                     Brr(a(0), ii - 3) = Brr(a(0), ii - 3) + zjj
    
37.                     Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + Arr(a(2), 3) * Brr(a(0), ii - 3)
    
38.                 Else
    
39.                     Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + Arr(a(2), 3) * Brr(a(0), ii - 3)
    
40.                 End If
    
41.             Else  '计算成本
    
42.                 If Brr(a(0), ii - 3) = 0 Then
    
43.                     zjj = Arr(a(0), 3) * Arr(a(0), ii)
    
44.                 Else
    
45.                     zjj = Brr(a(0), ii - 3)
    
46.                 End If
    
47.                 Brr(a(2), ii - 3) = Brr(a(2), ii - 3) + zjj * Arr(a(2), 3)
    
48.             End If
    
49.         Next
    
50.     End If
    
51. Next
    
52. Brr(1, ii - 3) = Cells(1, ii + 5).Value
    
53. Next
    
54. Cells(1, 9).Resize(UBound(Arr), 4) = Brr
    
55. End Sub
    
56. 
    

复制代码