EXCEL 如何自动生成BOM对应关系（生产企业物料父子级关系）

li_eva

尊敬的前辈们，我是一名汽车零配件生产企业的成本会计，由于ERP软件没有购买制造模块（购价高昂），故在制品管理需要通过手动报产的方式进行，那么，当我完工一个产成品的时候，组成该产成品的半成品需要相应减少，当我制造一个半成品的时候，组成该半成品的原材料需要相应减少，我想要达到的目的是：
车间生产统计每天会提供生产日报表，比如生产产成品A100个，当我在表格中输入A 100个时，我希望在另一边或者另一个工作表格得到100个A需要消耗的半成品清单B和C及数量；
当生产统计提供我B和C的产量时，我在表格中录入B和C的产量，另外一个工作表能生成B和C需要消耗的原材料清单名称及数量；
总之就是物料的一增一减，是需要建立这个对应关系，我上传了一个附件，这个附件就是其中某一个零件的BOM，希望前辈以这个为例子，帮我设计一个报产的模型，谢谢，不胜感激~~~~~~~~~~~~

cbtaja

BOM.zip (19.76 KB, 下载次数: 261)

2016-4-13 23:48 上传

点击文件名下载附件

代码以楼下的为准。

cbtaja

楼上的附件里的代码有一点小问题，修改后如下，就不再另上附件了：

1. Sub test()
   
2. arr = [a1].CurrentRegion.Resize(, 4)
   
3. rkwl = [f2]
   
4. rksl = [g2]
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. 
   
7. Set dic = CreateObject("Scripting.dictionary")
   
8. For i = 2 To UBound(arr)
   
9.     If rkwl = arr(i, 2) Then
   
10.         cj = Val(Replace(arr(i, 1), "-", ""))
    
11.         For j = i + 1 To UBound(arr)
    
12.             cj1 = Val(Replace(arr(j, 1), "-", ""))
    
13.             If cj1 = cj + 1 Then
    
14.                 p = p + 1
    
15.                 brr(p, 1) = arr(j, 2)
    
16.                 brr(p, 2) = arr(j, 4) * rksl '
    
17.             Else
    
18.                 Exit For
    
19.             End If
    
20.         Next
    
21.         Range("f5", Cells(Rows.Count, 7)).ClearContents
    
22.         If p > 0 Then [f5].Resize(p, 2) = brr
    
23.         Exit Sub
    
24.     End If
    
25. Next
    
26. End Sub
    

复制代码

opiona

1.     Set SH1 = Sheets("Sheet1")
   
2.     Set SH2 = Sheets("Sheet2")
   
3.     Set SH3 = Sheets("Sheet2")
   
4.     SH3.Range("D2:J65536").ClearContents
   
5.    
   
6.     StrSQL = StrSQL & "SELECT C.入库物料,C.数量,D.物料号 AS 出库物料,ROUND(C.数量*D.BOM用量,4) AS 出库数量,C.父层级,D.层级 FROM ("
   
7.     StrSQL = StrSQL & "SELECT A.入库物料,B.物料号,IIF(B.层级='Parent',0,val(mid(B.层级,len(B.层级),1))) AS 父层级,A.数量 FROM ("
   
8.     StrSQL = StrSQL & "SELECT 入库物料,数量 FROM [" & SH3.Name & "$A:B]"
   
9.     StrSQL = StrSQL & ") AS A,("
   
10.     StrSQL = StrSQL & "SELECT 层级,物料号,描述,BOM用量 FROM [" & SH1.Name & "$A:D]"
    
11.     StrSQL = StrSQL & ") AS B"
    
12.     StrSQL = StrSQL & " WHERE A.入库物料=B.物料号"
    
13.     StrSQL = StrSQL & ") AS C LEFT JOIN ("
    
14.     StrSQL = StrSQL & "SELECT 层级,物料号,描述,BOM用量 FROM [" & SH1.Name & "$A:D]"
    
15.     StrSQL = StrSQL & ") AS D ON C.父层级+1=VAL(MID(D.层级,LEN(D.层级),1))"
    
16. 
    
17.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=1';Data Source =" & ThisWorkbook.FullName     '//OFFICE2007
    
18.         Dim CN, RS
    
19.         Set CN = CreateObject("Adodb.Connection") '//新建一个ADO连接
    
20.         Set RS = CreateObject("adodb.recordset")
    
21.         CN.Open Str_coon
    
22.         RS.Open StrSQL, CN, 1, 3
    
23.         For ICOL = 0 To RS.Fields.Count - 1 '循环所有查询结果的列
    
24.             SH3.Cells(1, ICOL + 4) = RS.Fields(ICOL).Name
    
25.         Next ICOL
    
26.         SH3.Range("D2").CopyFromRecordset RS
    
27.         CN.Close  '//关闭ADO连接
    
28.         Set RS = Nothing
    
29.         Set CN = Nothing  '//释放内存

复制代码

opiona

支持批量查询
物料级别超过9，会出错！

BOM.rar (24.19 KB, 下载次数: 678)

2016-4-14 08:37 上传

点击文件名下载附件

li_eva

跪谢~~~先看看己能否理解。

dling218

我们也是需要靠手工来整理

思而学CPA梁

好复杂， 不是一般人用得来。厉害