excelhome中有关BOM的部分内容

sdxiaomuyu · 发表于 2012-2-12 20:52

多谢整理。

liucqa · 发表于 2012-2-12 20:59

留个记号

香川群子 · 发表于 2012-2-12 22:33

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

代码加了简单注释：

Sub test()
arr = Sheet1.[a1].CurrentRegion '获取原始Bom数据到数组arr
m = 9 '暂且假定bom最大阶数9,1-9阶。如果需要你可以继续增大此参数。
ReDim brr(1 To UBound(arr), 1 To m * 2 + 1) '定义结果数组brr
For i = 2 To UBound(arr) '遍历原始数据
If arr(i, 1) <> arr(i - 1, 1) Then '产品名不同时
k = k + 1 '重新开始一行
brr(k, 1) = arr(i, 1)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
l = 1 '指定阶数从1开始
Else '产品名相同时继续
If Val(arr(i, 2)) > Val(arr(i - 1, 2)) Then
'如果阶数增加,则在同一行内继续展开
brr(k, l * 2 + 2) = arr(i, 2)
brr(k, l * 2 + 3) = arr(i, 3)
l = l + 1 '阶数+1
If l > n Then n = l '比较获取历史最高阶数
Else '如果阶数相同或者减小
k = k + 1 '那么需要新增一行
brr(k, 1) = brr(k - 1, 1) '产品名照抄上一行
l = Val(arr(i, 2)) '获取当前阶数
For j = 1 To l - 1 '可以照抄到L-1阶
brr(k, j * 2) = brr(k - 1, j * 2)
brr(k, j * 2 + 1) = brr(k - 1, j * 2 + 1)
Next
'照抄完L-1阶数据以后，写入L阶的数据
brr(k, j * 2) = arr(i, 2)
brr(k, j * 2 + 1) = arr(i, 3)
End If
End If
Next
MsgBox k & " 行 " & n * 2 + 1 & " 列" '实际得到数据的行数和列数
Sheet2.[a2].Resize(k, n * 2 + 1) = brr '输出结果到sheet2
End Sub

复制代码

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

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

真是奇妙》》》

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

yiyiyicz · 发表于 2012-3-14 17:05

本帖最后由 yiyiyicz 于 2012-3-15 22:27 编辑

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

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

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

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

yiyiyicz · 发表于 2012-3-15 22:48

本帖最后由 yiyiyicz 于 2012-3-16 06:59 编辑

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

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

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

yiyiyicz · 发表于 2012-4-27 10:06

本帖最后由 yiyiyicz 于 2012-4-27 10:17 编辑

这是一个例子，原帖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 · 发表于 2012-4-27 10:19

本帖最后由 yiyiyicz 于 2012-4-27 10:27 编辑

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)
k = k + 1
End If
Next j
Next i
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) * d(Pc1(i, 1))
Next i
Range("i21").Resize(d.Count, 1) = Application.Transpose(d.Keys)
Range("j21").Resize(d.Count, 1) = Application.Transpose(d.Items)
Range("d21").Resize(UBound(Pc1), 4) = Pc1
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 · 发表于 2012-4-27 10:30

本帖最后由 yiyiyicz 于 2012-4-27 10:34 编辑

对于不改“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 · 发表于 2012-4-27 10:43

本帖最后由 yiyiyicz 于 2012-4-27 10:44 编辑

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

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

umi23 · 发表于 2012-8-8 15:04

学习了学习了

		自动登录	找回密码
密码			免费注册

[分享] excelhome中有关BOM的部分内容