BOM递归过程中扣除库存数据

1588078/37

递归代码是COPY论坛 里面，做了些调整而已因数据是直连SQL数据库导出来的
要做MRP
现在得把订单跑到最后一阶BOM，然后再把库存跑遍最后一阶BOM，来计算生产订单的线上在制库存

1. Sub 月物料需求()
   
2. Application.ScreenUpdating = False '//关闭屏幕刷新
   
3.     Application.DisplayAlerts = False '//关闭系统提示
   
4.     Application.EnableEvents = False  '//禁止触发其他事件
   
5. 'On Error Resume Next
   
6. Set d = CreateObject("scripting.dictionary")
   
7. Set dic = CreateObject("scripting.dictionary")
   
8. Set d1 = CreateObject("scripting.dictionary")
   
9. Set d2 = CreateObject("scripting.dictionary")
   
10. Dim t!
    
11. t = Timer
    
12. Call OpenErp
    
13. SQL = "select pk_material,code,name from bd_material"
    
14. DBRst.Open SQL, ConnDB, adOpenKeyset, adLockOptimistic
    
15. Arr = DBRst.GetRows
    
16. For i = 0 To UBound(Arr, 2)
    
17. d(Arr(0, i)) = Arr(1, i) & "|" & Arr(2, i)
    
18. dic(CStr(Arr(1, i))) = Arr(0, i)
    
19. Next
    
20. 'Sheet2.Cells(1, 1).Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
    
21. Call CloseErp
    
22. Call CloseErp
    
23. Call OpenErp
    
24. SQL = "select cmaterialoid,sum(nonhandnum) from StockOnHand t1 left join bd_stordoc t2 on t1.cwarehouseid=t2.pk_stordoc where stockdate=(select MAX(stockdate) from StockOnHand) and t2.name like '%线上仓%' group by cmaterialoid"
    
25. DBRst.Open SQL, ConnDB, adOpenKeyset, adLockOptimistic
    
26. Arr = DBRst.GetRows
    
27. Call CloseErp
    
28. For i = 0 To UBound(Arr)
    
29. d1(Arr(0, i)) = Arr(1, i)
    
30. Next
    
31. Call OpenErp
    
32. SQL = "select 物料编码,bom版本,sum(数量) from (select x2.name as 类型,cmaterialvid as 物料编码,cbomversionid  as bom版本,x1.nplanputnum-isnull(x1.nwrnum,0) as 数量 from (select t1.vbillcode,t2.cmaterialvid,cdeptvid,cbomversionid,t2.nplanputnum,t2.nwrnum from (select distinct cpmohid,dbilldate,vbillcode from mm_pmo  where  dbilldate  >= '2019-11-01 00:00:00'  and dr = 0  AND fbillstatus=1 AND ctrantypeid='0001A910000000002F40') t1 " & _
    
33. "Left Join (SELECT cpmohid,cmaterialvid,cdeptvid,nplanputnum,nwrnum,cbomversionid from mm_mo where   mm_mo.dr = 0 and fitemstatus!=3 and  fitemstatus!=2) t2 " & _
    
34. "on t1.cpmohid=t2.cpmohid where t2.cmaterialvid is not null) x1 left join org_dept_v x2 on x1.cdeptvid=x2.pk_vid  union all select '外加工' as 类型,t2.pk_material  as 物料编码,t2.vbomversion as bom版本,t2.nnum-ISNULL(naccumstorenum,0) as 数量  from sc_order t1 left join sc_order_b t2 on t1.pk_order=t2.pk_order where dbilldate>'2019-11-01 00:00:00' and t1.dr=0 and t2.dr=0 and t1.fstatusflag=3 and t2.nnum-ISNULL(naccumstorenum,0)>0) m1 group by 物料编码,bom版本"
    
35. DBRst.Open SQL, ConnDB, adOpenKeyset, adLockOptimistic
    
36. Arr = DBRst.GetRows
    
37. For i = 0 To UBound(Arr, 2)
    
38. If Len(Arr(1, i)) > 10 Then
    
39. m2 = m2 & ",'" & Arr(1, i) & "'"
    
40. m1 = m1 & ",'" & Arr(0, i) & "'"
    
41. End If
    
42. Next
    
43. 'Sheet5.[a1].Resize(UBound(Arr) + 1, UBound(Arr, 2) + 1) = Arr
    
44. Call OpenErp
    
45. SQL = "select t1.hcmaterialid,t2.cmaterialid,nitemnum,ndissipationum,t1.cbomid  from bd_bom t1 left join   bd_bom_b t2 on t1.cbomid=t2.cbomid where t2.dr<>1 and  t1.cbomid in  (" & Mid(m2, 2) & ") union all " & _
    
46. "select t1.hcmaterialid,t2.cmaterialid,nitemnum,ndissipationum,t1.hversion  from (select cbomid,hversion,hvnote,hcmaterialid from (select no =row_number() over (partition by hcmaterialid order by ts desc), * from bd_bom) t where no=1) t1 left join   bd_bom_b t2 on t1.cbomid=t2.cbomid where t2.dr<>1 and  hcmaterialid not in  (" & Mid(m1, 2) & ")"
    
47. DBRst.Open SQL, ConnDB, adOpenKeyset, adLockOptimistic
    
48. arx = DBRst.GetRows
    
49. Call CloseErp
    
50. ReDim brr(1 To 20000, 1 To 5)
    
51.   ReDim brr1(1 To 20000, 1 To 5)
    
52. For i = 0 To UBound(Arr, 2)
    
53.   ID_cp = Arr(0, i)
    
54.    bbh = Arr(1, i)
    
55.     kk = 0
    
56.     cp = Arr(0, i)
    
57.     ReDim BRX(1 To 3, 1 To 1)
    
58.       ReDim krx(1 To 3, 1 To 1)
    
59.     Call KCBOM(ID_cp, Arr(2, i))
    
60.     crx = Application.Transpose(Application.Transpose(BRX))
    
61.     crx1 = Application.Transpose(Application.Transpose(krx))
    
62.     For b = 1 To UBound(crx, 2)
    
63.     m = m + 1
    
64. If d.exists(crx(1, b)) Then
    
65. brr(m, 1) = "'" & Split(d(crx(1, b)), "|")(0)
    
66. brr(m, 2) = Split(d(crx(1, b)), "|")(1)
    
67. Else
    
68. s1 = s1 & "," & "'" & Arr(0, i)
    
69. End If
    
70. If d.exists(crx(2, b)) Then
    
71. brr(m, 3) = "'" & Split(d(crx(2, b)), "|")(0)
    
72. brr(m, 4) = Split(d(crx(2, b)), "|")(1)
    
73. End If
    
74. brr(m, 5) = crx(3, b)
    
75. Next
    
76. For b = 1 To UBound(crx1, 2)
    
77. If Len(crx1(1, b)) > 10 Then
    
78.     mm = mm + 1
    
79. d2(d(crx1(2, b))) = d2(d(crx1(2, b))) + crx1(3, b)
    
80. End If
    
81. Next
    
82. Next
    
83. Sheet3.Range("a1").Resize(m, 5) = brr
    
84. Sheet4.Range("a1").Resize(1, d2.Count) = d2.keys
    
85. Sheet4.Range("a2").Resize(1, d2.Count) = d2.items
    
86. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒" '//提示所用时间
    
87. 
    
88. Application.EnableEvents = True  '//禁止触发其他事件
    
89.     Application.DisplayAlerts = True '//关闭系统提示
    
90. Application.ScreenUpdating = True '//关闭屏幕刷新
    
91. 
    
92. End Sub
    

复制代码

想在订单拆解BOM过程中，直接扣除d1(Arr(0, i)) 这个的库存数据

1588078/37

月 周计划，导入数据库，运行月周计划时，扣除已入库量，计算净生产需求的物料需求量，再计算在制订单的线上结余数据， 库存的物料结余，得出物料净需求，再去匹配订单信息，计算下单需求

1588078/37

求助谢谢 求助

zpy2

表格没有数据，建议模拟一下结果，方便大家一起研究。

1588078/37

zpy2 发表于 2019-11-14 07:47
表格没有数据，建议模拟一下结果，方便大家一起研究。

连接SQL数据库的，没数据，，，只有拆解到最后一阶BOM的需求量，，不知道中间过程如何来扣，换字典代替递归的方法，运行太慢了，