Call 山菊花 & jsxjd & 香川群子老师、根据日程计划自动计算物料需求计划

Day-Day

各位大虾：

依据日程计划中的数据、通过BOM清单中相对应的原材料、求得每日物料需求！

备注：根据日程计划、BOM表中的所需要的材料不一定要全部反映在物料需求表中，物料需求表中不体现的物料不需要自动计算！

由于BOM表较大、希望通过利用VBA的形似解决！

物料需求計劃2.rar (80.71 KB, 下载次数: 100)

2014-9-3 23:25 上传

点击文件名下载附件

万分感谢！

Day-Day

在线急等！
希望各位前辈、斑竹、大虾们挤点时间帮帮ME

99188407

小妹我也需要这样的东东、希望有仁之士助之！
急...

Day-Day

99188407 发表于 2014-9-3 18:55
小妹我也需要这样的东东、希望有仁之士助之！
急...

对啊，都没有人帮忙啊。55

cbtaja

帮老乡做一个：

1. Sub 更新()
   
2. With Sheet3
   
3.     r = .Cells(Rows.Count, 1).End(3).Row - 1
   
4.     arr = .Range("A2:M" & r + 1) 'BOM数据
   
5. End With
   
6. Set dic1 = CreateObject("Scripting.Dictionary") '材料
   
7. Set dic2 = CreateObject("Scripting.Dictionary") '产品
   
8. For i = 2 To r
   
9.     If Len(arr(i, 1)) > 0 Then
   
10.         If Not dic1.exists(arr(i, 9)) Then
    
11.             n1 = n1 + 1
    
12.             dic1(arr(i, 9)) = n1
    
13.         End If
    
14.         If dic2.exists(arr(i, 1)) Then
    
15.             dic2(arr(i, 1)) = Array(dic2(arr(i, 1))(0), i)
    
16.         Else
    
17.             dic2(arr(i, 1)) = Array(i, i)
    
18.         End If
    
19.     End If
    
20. Next
    
21. With Sheet1
    
22.     endrow = .Cells(Rows.Count, 1).End(3).Row - 3
    
23.     crr = .Range("A4:AK" & endrow + 3) '日程计划数据
    
24. End With
    
25. ReDim drr(1 To n1, 7 To 38)
    
26. For i = 3 To endrow
    
27.     If Len(crr(i, 1)) > 0 Then
    
28.         For j = 7 To 37
    
29.             If crr(i, j) > 0 Then
    
30.                 qz = dic2(crr(i, 1)) '查产品对应BOM表的起止行号数组
    
31.                 For k = qz(0) To qz(1)
    
32.                     clxh = dic1(arr(k, 9))
    
33.                     drr(clxh, j) = drr(clxh, j) + arr(k, 13) * crr(i, j)
    
34.                     drr(clxh, 38) = drr(clxh, 38) + arr(k, 13) * crr(i, j)
    
35.                 Next
    
36.             End If
    
37.         Next
    
38.     End If
    
39. Next
    
40. With Sheet2
    
41.     .UsedRange.Offset(5, 5).Resize(, 1).ClearContents
    
42.     .UsedRange.Offset(5, 5).ClearContents
    
43.     .[c6].Resize(dic1.Count, 1) = Application.Transpose(dic1.keys)
    
44.     .[f6].Resize(n1, 32) = drr
    
45. End With
    
46. End Sub
    

复制代码

cbtaja

Day-Day 发表于 2014-9-3 20:21
对啊，都没有人帮忙啊。55

附件在此……。

Day-Day

cbtaja 发表于 2014-9-3 20:46
附件在此……。

非常感谢、但是如若需要固定物料的所在行，就会出现问题，烦请再修改一下下。
谢谢、另外补充一点：根据日程计划、BOM表中的所需要的材料不一定要全部反映在物料表中，只要物料表中有的材料名称计算就行！

物料需求計劃2.rar (84.4 KB, 下载次数: 24)

2014-9-3 21:15 上传

点击文件名下载附件

Day-Day

在线等啊、拜托。

cbtaja

Day-Day 发表于 2014-9-3 21:16
非常感谢、但是如若需要固定物料的所在行，就会出现问题，烦请再修改一下下。
谢谢、另外补充一点：根 ...

1. Sub 更新()
   
2. Set dic1 = CreateObject("Scripting.Dictionary") '材料
   
3. Set dic2 = CreateObject("Scripting.Dictionary") '产品
   
4. r = Sheet2.Cells(Rows.Count, 3).End(3).Row
   
5. arr = Sheet2.[c6].Resize(r - 5, 3)
   
6. For i = 1 To UBound(arr)
   
7.     If Len(arr(i, 1)) > 0 Then
   
8.         dic1(arr(i, 1)) = i
   
9.     Else
   
10.         kcl = kcl + 1
    
11.         dic1("(空材料)_" & kcl) = i
    
12.     End If
    
13. Next
    
14. kcl = kcl + 1
    
15. dic1("(空材料)_" & kcl) = i
    
16. n1 = i ' + 1
    
17. With Sheet3
    
18.     r = .Cells(Rows.Count, 1).End(3).Row - 1
    
19.     arr = .Range("A2:M" & r + 1) 'BOM数据
    
20. End With
    
21. For i = 2 To r
    
22.     If Len(arr(i, 1)) > 0 Then
    
23.         If Not dic1.exists(arr(i, 9)) Then
    
24.             n1 = n1 + 1
    
25.             dic1(arr(i, 9)) = n1
    
26.         End If
    
27.         If dic2.exists(arr(i, 1)) Then
    
28.             dic2(arr(i, 1)) = Array(dic2(arr(i, 1))(0), i)
    
29.         Else
    
30.             dic2(arr(i, 1)) = Array(i, i)
    
31.         End If
    
32.     End If
    
33. Next
    
34. With Sheet1
    
35.     endrow = .Cells(Rows.Count, 1).End(3).Row - 3
    
36.     crr = .Range("A4:AK" & endrow + 3) '日程计划数据
    
37. End With
    
38. ReDim drr(1 To n1, 7 To 38)
    
39. For i = 3 To endrow
    
40.     If Len(crr(i, 1)) > 0 Then
    
41.         For j = 7 To 37
    
42.             If crr(i, j) > 0 Then
    
43.                 qz = dic2(crr(i, 1)) '查产品对应BOM表的起止行号数组
    
44.                 For k = qz(0) To qz(1)
    
45.                     clxh = dic1(arr(k, 9))
    
46.                     drr(clxh, j) = drr(clxh, j) + arr(k, 13) * crr(i, j)
    
47.                     drr(clxh, 38) = drr(clxh, 38) + arr(k, 13) * crr(i, j)
    
48.                 Next
    
49.             End If
    
50.         Next
    
51.     End If
    
52. Next
    
53. With Sheet2
    
54.     .UsedRange.Offset(5, 5).ClearContents
    
55.     dkey = dic1.keys
    
56.     For i = 0 To UBound(dkey)
    
57.         If Left(dkey(i), 6) = "(空材料)_" Then dkey(i) = ""
    
58.     Next
    
59.     .[c6].Resize(dic1.Count, 1) = Application.Transpose(dkey)
    
60.     .[f6].Resize(n1, 32) = drr
    
61. End With
    
62. End Sub

复制代码

Day-Day

cbtaja 发表于 2014-9-3 22:42

万分感谢，但是好像还是有点问题、例如去掉了物料需求表中的 "D-1-3”,为何底下又显示了此物料。
我的意思是：物料需求表中不显示的物料就不需要自动计算。烦请帮忙再修改一下。
真心不好意思
物料需求計劃2.rar (85.04 KB, 下载次数: 48)

2014-9-3 23:07 上传

点击文件名下载附件