BOM智能计算

lsfeng

蓝桥老师，这个结果是对的，但没能实现在BOM中增加文件，ReqQty0915.xls 中的计算包含新增部分。
目的：在BOM中增加新的BOM，MPS1中加入新增的型号（以新增BOM文件名的型号），ReqQty0915
计算自动包含，这才体现自动化。也是想主要实现的功能，谢谢！

蓝桥玄霜

在BOM中增加新的BOM，MPS1中加入新增的型号
与此代码没有冲突的。

lsfeng

蓝桥玄霜 发表于 2013-9-15 15:04
在BOM中增加新的BOM，MPS1中加入新增的型号
与此代码没有冲突的。

估计我在MPS1中放错型号所致，可以了，非常感谢蓝桥版主！水平高也不厌其烦提供无私的帮助！

再多问一个问题：

为提高程序的通用性，能否做到BOM文件夹下面的BOM文件，不限制其列数，只要某一列包含Qty,就仁该列为计算的数据，这样无任不同列数
的BOM放进去，都能计算正确，只要规定含有一列Qty表示数量即可（唯一的一列）。做起来程序来麻烦不？

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim Arr, myPath$, myName$, Arr1, Myr&, d, cs$, d1, k, t
   
3.     Dim nm$, Brr, y&, m&, dz, d2, dd
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set dd = CreateObject("Scripting.Dictionary")
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     Set dz = CreateObject("Scripting.Dictionary")
   
8.     Set d2 = CreateObject("Scripting.Dictionary")
   
9.     Application.ScreenUpdating = False
   
10.     Sheet1.Activate
    
11.     cs = "MPS1"
    
12.     myPath = ThisWorkbook.Path & ""
    
13.     myName = cs & ".xls"
    
14.     With GetObject(myPath & myName)
    
15.         Arr1 = .Sheets(1).Range("A1").CurrentRegion
    
16.         For i = 2 To UBound(Arr1)
    
17.             d(Arr1(i, 1)) = d(Arr1(i, 1)) & i & ","
    
18.         Next
    
19.         For i = 3 To UBound(Arr1, 2)
    
20.             dz(Arr1(1, i)) = i
    
21.         Next
    
22.         .Close False
    
23.     End With
    
24.     k = d.keys: t = d.items
    
25.     myPath = ThisWorkbook.Path & "\BOM"
    
26.     myName = Dir(myPath & "*.xls")
    
27.     Do While myName <> ""
    
28.         nm = Split(myName, ".")(0)
    
29.         If d.exists(nm) Then
    
30.         With GetObject(myPath & myName)
    
31.             Arr = .Sheets(1).Range("A1").CurrentRegion
    
32.             For i = 1 To UBound(Arr, 2)
    
33.                 dd(Arr(1, i)) = i
    
34.             Next
    
35.             For i = 2 To UBound(Arr)
    
36.                 d1(Arr(i, dd("Part No")) & "|" & nm) = Arr(i, dd("Qty"))
    
37.                 x = Arr(i, dd("Part No")) & "," & Arr(i, dd("Description")) & "," & Arr(i, dd("MU"))
    
38.                 d2(x) = ""
    
39.             Next
    
40.             .Close False
    
41.         End With
    
42.         End If
    
43.         myName = Dir
    
44.     Loop
    
45.     Cells.ClearContents
    
46.     [a1].Resize(1, 3) = Array("Part No", "Description", "MU")
    
47.     [a2].Resize(d2.Count) = Application.Transpose(d2.keys)
    
48.     Application.DisplayAlerts = False
    
49.     [a2].Resize(d2.Count).TextToColumns DataType:=xlDelimited, Comma:=True
    
50.     Range("d1").Resize(1, dz.Count) = dz.keys
    
51.     Brr = [a1].CurrentRegion
    
52.     For i = 2 To UBound(Brr)
    
53.         For j = 4 To UBound(Brr, 2)
    
54.             For y = 2 To UBound(Arr1)
    
55.                 If d1.exists(Brr(i, 1) & "|" & Arr1(y, 1)) Then
    
56.                     Brr(i, j) = Brr(i, j) + d1(Brr(i, 1) & "|" & Arr1(y, 1)) * Arr1(y, j - 1)
    
57.                 End If
    
58.             Next
    
59.         Next
    
60.     Next
    
61.     [a1].CurrentRegion = Brr
    
62.     Application.DisplayAlerts = True
    
63.     Application.ScreenUpdating = True
    
64. End Sub
    
65. 
    

复制代码

lsfeng

程序符合题目提出的4点要求！蓝桥版主，再次谢谢！

lsfeng

蓝桥玄霜 发表于 2013-9-15 19:41

蓝桥博士，这几天看了你的“蓝桥方法”计算分层次的BOM，确实很好，您做的这个程序要是能同时处理多层BOM就牛了。多层与单层弄在一起，原理上行的通吗？

lsfeng

蓝桥玄霜 发表于 2013-9-15 19:41

蓝桥博士，您好！
您给提供的BOM计算我用到PMC物料计算中，后面的PR计算我本想自己写个小程序，能用，超慢。
其中用了2个For Next 循环实现。简直无法接受，比现在公式做的还慢。
您看看能否把表中的PR用VBA得到，我目前是用长长的公式。

说明见附件，谢谢！

2007小金猪

shoufahnag

lsfeng

蓝桥玄霜 发表于 2013-9-15 19:41

对不起，上传附件可能有问题

lsfeng

蓝桥玄霜 发表于 2013-9-15 19:41

蓝桥老师，你做的这个程序实际应用中遇到一个问题：

如果MPS里面的型号超出BOM文件夹下面的BOM的实际个数，结果是看不出的，例如：
MPS可能有100个型号，但BOM文件夹里面可能只包含100个型号中的99个，少一个，那么计算结果你不会知道到底是否漏了一个或几个BOM。

如果能出现一句话提示： 1.如果MPS中的每个型号都被计算过，显示计算完毕；2，如果MPS中有那个型号未能在BOM文件夹里面找到相应的BOM，则提示”XXX“型号缺少BOM，那就更实用了。谢谢！