excelhome中有关BOM的部分内容

sdxiaomuyu

多谢整理。

liucqa

留个记号         

香川群子

BOM父子一维表转树状结构的代码实例：

代码加了简单注释：

1. Sub test()
   
2.     arr = Sheet1.[a1].CurrentRegion '获取原始Bom数据到数组arr
   
3.    
   
4.     m = 9 '暂且假定bom最大阶数9,1-9阶。如果需要你可以继续增大此参数。
   
5. 
   
6.     ReDim brr(1 To UBound(arr), 1 To m * 2 + 1) '定义结果数组brr
   
7.    
   
8.     For i = 2 To UBound(arr) '遍历原始数据
   
9.    
   
10.         If arr(i, 1) <> arr(i - 1, 1) Then '产品名不同时
    
11.             k = k + 1 '重新开始一行
    
12.             brr(k, 1) = arr(i, 1)
    
13.             brr(k, 2) = arr(i, 2)
    
14.             brr(k, 3) = arr(i, 3)
    
15.             l = 1 '指定阶数从1开始
    
16.         Else '产品名相同时继续
    
17.             If Val(arr(i, 2)) > Val(arr(i - 1, 2)) Then
    
18.              '如果阶数增加,则在同一行内继续展开
    
19.                 brr(k, l * 2 + 2) = arr(i, 2)
    
20.                 brr(k, l * 2 + 3) = arr(i, 3)
    
21.                 l = l + 1 '阶数+1
    
22.                 If l > n Then n = l '比较获取历史最高阶数
    
23.             Else '如果阶数相同或者减小
    
24.                 k = k + 1 '那么需要新增一行
    
25.                 brr(k, 1) = brr(k - 1, 1) '产品名照抄上一行
    
26.                 l = Val(arr(i, 2)) '获取当前阶数
    
27.                 For j = 1 To l - 1 '可以照抄到L-1阶
    
28.                     brr(k, j * 2) = brr(k - 1, j * 2)
    
29.                     brr(k, j * 2 + 1) = brr(k - 1, j * 2 + 1)
    
30.                 Next
    
31.                 '照抄完L-1阶数据以后，写入L阶的数据
    
32.                 brr(k, j * 2) = arr(i, 2)
    
33.                 brr(k, j * 2 + 1) = arr(i, 3)
    
34.             End If
    
35.         End If
    
36.     Next
    
37.    
    
38.     MsgBox k & " 行 " & n * 2 + 1 & " 列" '实际得到数据的行数和列数
    
39.     Sheet2.[a2].Resize(k, n * 2 + 1) = brr '输出结果到sheet2
    
40.    
    
41. End Sub

复制代码

本来是某个新手的求助帖。

我下载附件，写好代码以后，因为网络断线，再上来看，这个帖子找不到了……

真是奇妙》》》


既然楼主也关心，我就把例子附在这里，如能帮到其他人也好。呵呵。

yiyiyicz

在VBA中实现BOM的展开、汇总、查询，有三种方法工具

1，字典法。
递阶循环用字典方法比较多

2，引用MSXML，树形数据存储
规范严谨，各种BOM转换比较容易并且概念也清晰。

3，透视表
将透视表作为计算引擎，可以汇总、查询

yiyiyicz

香川群子 发表于 2012-2-12 22:33
BOM父子一维表转树状结构的代码实例：

代码加了简单注释：本来是某个新手的求助帖。

我想，你能用VBA按照原帖主的希望表达出来，体现论坛助人为乐的精神
但是，原帖的目的似乎不合理

yiyiyicz

这是一个例子，原帖http://club.excelhome.net/forum. ... 4&page=1#pid5881750
下面是贴主给出的BOM

等级	号码	数量
1	123456-0001	1
2	234567-0001	1
2	234567-0002	1
2	234567-0003	1
3	456789-0001	1
3	456789-0002	1
3	456789-0003	1
2	234567-0003	1
3	456789-0001	1
3	456789-0002	1
3	456789-0003	1
2	234567-0004	1
3	456789-0001	1
3	456789-0001	1
3	456789-0001	1

这份表格，格式上是BOM。但仔细看，同为2级物料项的“234567-0003”却出现了二次，而且所包含下级（3级）物料项完全一致，所以BOM在逻辑上有问题，将来进一步处理会带来不少麻烦。为了说明问题，简单地把第二次出现的“234567-0003”改为“234567-0005”。当然下级物料项还是完全相同，这在逻辑上变成一物两码。但是并不影响BOM展开计算

yiyiyicz

1. Sub t()
   
2. Dim Arr, Pc1
   
3. Dim Nmin As Integer, Nmax As Integer
   
4. Arr = Range("a2:c" & [a65536].End(3).Row)
   
5. Nmin = Application.WorksheetFunction.Min(Range("a2:a" & [a65536].End(3).Row))
   
6. Nmax = Application.WorksheetFunction.Max(Range("a2:a" & [a65536].End(3).Row))
   
7. '根据本例的特点，顶层只有一个物料项。并且位于arr数组第一列
   
8. ReDim Pc1(1 To 100, 1 To 4)
   
9. k = 1
   
10. temp1 = Arr(1, 2)
    
11. temp2 = Arr(1, 3)
    
12. For i = Nmin + 1 To Nmax
    
13.     For j = 2 To UBound(Arr)
    
14.         If Arr(j, 1) = i Then
    
15.             If Arr(j - 1, 1) = i - 1 Then
    
16.                 temp1 = Arr(j - 1, 2)
    
17.                 temp2 = Arr(j - 1, 3)
    
18.             End If
    
19.                 Pc1(k, 1) = temp1
    
20.                 Pc1(k, 2) = temp2
    
21.                 Pc1(k, 3) = Arr(j, 2)
    
22.                 Pc1(k, 4) = Arr(j, 3)
    
23.                 k = k + 1
    
24.         End If
    
25.         
    
26.     Next j
    
27. Next i
    
28. Dim d As New Dictionary
    
29. d(Pc1(1, 1)) = d(Pc1(1, 1)) + Pc1(1, 2)
    
30. For i = 1 To UBound(Pc1)
    
31.     x = Pc1(i, 3)
    
32.     d(x) = d(x) + Pc1(i, 4) * d(Pc1(i, 1))
    
33. Next i
    
34. Range("i21").Resize(d.Count, 1) = Application.Transpose(d.Keys)
    
35. Range("j21").Resize(d.Count, 1) = Application.Transpose(d.Items)
    
36. Range("d21").Resize(UBound(Pc1), 4) = Pc1
    
37. End Sub

复制代码

对于改“234567-0003”为“234567-0005”的情况，代码如上
代码主要做了两项工作：
1，将BOM转换为一个表示父子关系的数组。在excel中表现为

父项	父项数量	子项	子项数量
123456-0001	1	234567-0001	1
123456-0001	1	234567-0002	1
123456-0001	1	234567-0003	1
123456-0001	1	234567-0003	1
123456-0001	1	234567-0004	1
234567-0003	1	456789-0001	1
234567-0003	1	456789-0002	1
234567-0003	1	456789-0003	1
234567-0003	1	456789-0001	1
234567-0003	1	456789-0002	1
234567-0003	1	456789-0003	1
234567-0004	1	456789-0001	1
234567-0004	1	456789-0001	1
234567-0004	1	456789-0001	1

2，汇总所有的物料项，计算出他们的总数。注意：这里和层级没有关系了。因为在一个BOM中，同一个物料项可能出现在不同地方，层级也不一样。最后，我们要的各个物料项需要多少个，而不是他们在不同层级中需要的数量
在excel表格中结果就是：

号码	数量
123456-0001	1
234567-0001	1
234567-0002	1
234567-0003	2
234567-0004	1
456789-0001	7
456789-0002	4
456789-0003	4

yiyiyicz

对于不改“234567-0003”的情况。虽然也可以得到计算结果，但是就像凑数
[code=vb]
Sub t()
Dim Arr, Pc1
Dim Nmin As Integer, Nmax As Integer
Arr = Range("a2:c" & [a65536].End(3).Row)
Nmin = Application.WorksheetFunction.Min(Range("a2:a" & [a65536].End(3).Row))
Nmax = Application.WorksheetFunction.Max(Range("a2:a" & [a65536].End(3).Row))
'根据本例的特点，顶层只有一个物料项。并且位于arr数组第一列
ReDim Pc1(1 To 100, 1 To 4)
k = 1
temp1 = Arr(1, 2)
temp2 = Arr(1, 3)
For i = Nmin + 1 To Nmax
    For j = 2 To UBound(Arr)
        If Arr(j, 1) = i Then
            If Arr(j - 1, 1) = i - 1 Then
                temp1 = Arr(j - 1, 2)
                temp2 = Arr(j - 1, 3)
            End If
                Pc1(k, 1) = temp1
                Pc1(k, 2) = temp2
                Pc1(k, 3) = Arr(j, 2)
                Pc1(k, 4) = Arr(j, 3) * temp2
                Arr(j, 3) = Pc1(k, 4)
                k = k + 1
        End If
        
    Next j
Next i
Range("d21").Resize(UBound(Pc1), 4) = Pc1
Dim d As New Dictionary
d(Pc1(1, 1)) = d(Pc1(1, 1)) + Pc1(1, 2)
For i = 1 To UBound(Pc1)
    x = Pc1(i, 3)
    d(x) = d(x) + Pc1(i, 4)
Next i
Range("i21").Resize(d.Count, 1) = Application.Transpose(d.Keys)
Range("j21").Resize(d.Count, 1) = Application.Transpose(d.Items)
End Sub
[/code]
父子关系的表格为：

父项	父项数量	子项	子项数量
123456-0001	1	234567-0001	1
123456-0001	1	234567-0002	1
123456-0001	1	234567-0003	1
123456-0001	1	234567-0003	1
123456-0001	1	234567-0004	1
234567-0003	1	456789-0001	1
234567-0003	1	456789-0002	1
234567-0003	1	456789-0003	1
234567-0003	1	456789-0001	1
234567-0003	1	456789-0002	1
234567-0003	1	456789-0003	1
234567-0004	1	456789-0001	1
234567-0004	1	456789-0001	1
234567-0004	1	456789-0001	1

最后汇总的结果：

号码	数量
123456-0001	1
234567-0001	1
234567-0002	1
234567-0003	2
234567-0004	1
456789-0001	5
456789-0002	2
456789-0003	2

yiyiyicz

上述两种BOM展开，思路一样。
虽然概念一步步是清楚的，但是在数组处理中，代码啰嗦，占用内存大，代码不考究
本人VBA编程实在很菜，数组太难掌握

由于BOM是典型的树形结构。我觉得用msxml，应该是一种不错的选择。而且查询和局部变更在XML文件可以灵活处理
再有，“多重结构，树状显示，类似XML节点树，代码比XML简洁得多”也是选择之一
http://club.excelhome.net/forum. ... 2&page=1#pid3170407
这些在VBA中应用，figfig实在是NB

umi23

学习了学习了