根据生产计划表，用量基准表，计算对应日期的耗材用量

小白兔3399

大家好：

我想根据生产排产数量，用量基准，计算对应日期的耗材用量，有劳各位大神看看能不能用VBA做出来呀，
这是工作中的一项常态化的工作，实际数据量是比较大的，如果能用VBA处理就太好了，工作会极大减轻。非常感谢 耗材用量表.zip (22.92 KB, 下载次数: 10)

2023-4-27 20:59 上传

点击文件名下载附件

小白兔3399

银河懒麒麟

来来收货了

银河懒麒麟

我杂就上传不了呢

银河懒麒麟

Private Sub CommandButton1_Click() t = Timer With Sheets("生产计划")     生产计划 = .Range(.UsedRange.Address) End With With Sheets("基准表")     基准表 = .Range(.UsedRange.Address) End With  Dim 半成1 As Range, 部门1 As Range, 半成2 As Range, 耗材1 As Range, 单耗1 As Range Dim r半成 As Long, r部门 As Long, c半成 As Long, c部门 As Long, r半成2 As Long, r耗材 As Long, r单耗 As Long, c半成2 As Long, c耗材 As Long, c单耗 As Long, kk As Long, k As Long, i As Long, ii As Long, ooo As Long, iii As Long Set 半成1 = Sheets("生产计划").Range("1:5").Find("半成品") Set 部门1 = Sheets("生产计划").Range("1:5").Find("部门名称") Set 半成2 = Sheets("基准表").Range("1:5").Find("半成品") Set 耗材1 = Sheets("基准表").Range("1:5").Find("耗材料号") Set 单耗1 = Sheets("基准表").Range("1:5").Find("单耗")  If Not 半成1 Is Nothing Or Not 部门1 Is Nothing Or Not 半成2 Is Nothing Or Not 耗材1 Is Nothing Or Not 单耗1 Is Nothing Then     r半成 = 半成1.Row     r部门 = 部门1.Row     If r半成 = r部门 Then         c半成 = 半成1.Column         c部门 = 部门1.Column         Else         MsgBox "请检 生产计划中的1到5行中是否存在半成品》部门名称 "         Exit Sub     End If     r半成2 = 半成2.Row     r耗材 = 耗材1.Row     r单耗 = 单耗1.Row     If r半成2 = r耗材 And r耗材 = r单耗 Then         c半成2 = 半成2.Column         c耗材 = 耗材1.Column         c单耗 = 单耗1.Column         Else         MsgBox "请检查 基准表 中的1到5行中是否存在 半成品》》耗材料号 》单耗字段"         Exit Sub     End If End If For oo = 1 To UBound(生产计划, 2)     If IsDate(生产计划(r半成, oo)) Then     k = k + 1   Sheets("标准用量").Cells(2, 7 + k) = 生产计划(r半成, oo)     End If Next For ooo = 1 To UBound(生产计划, 2)     If IsDate(生产计划(r半成, ooo)) Then     ooo = ooo - 1     GoTo 11     End If Next 11: ReDim 标准用量(1 To UBound(生产计划, 1), 1 To 7 + k) For i = r半成 + 1 To UBound(生产计划, 1)     标准用量(i - 2, 2) = 生产计划(i, c部门)     标准用量(i - 2, 3) = 生产计划(i, c半成)     标准用量(i - 2, 1) = "检查基准表"     For ii = r半成2 + 1 To UBound(基准表, 1)         If 生产计划(i, c半成) = 基准表(ii, c半成2) Then             标准用量(i - 2, 1) = 基准表(ii, c耗材)             For iii = 1 To k             标准用量(i - 2, 7 + iii) = 基准表(ii, c单耗) * 生产计划(i, ooo + iii)             Next iii             GoTo 111         End If     Next 111: Next Sheets("标准用量").Cells(2, 1).Resize(UBound(标准用量), UBound(标准用量, 2)).Borders.LineStyle = xlContinuous Sheets("标准用量").Cells(3, 1).Resize(UBound(标准用量), UBound(标准用量, 2)) = 标准用量 Sheets("标准用量").Cells(3, 1).Resize(UBound(标准用量), UBound(标准用量, 2)) = 标准用量 t = Timer - t MsgBox "耗时" & t End Sub

银河懒麒麟

1. Private Sub CommandButton1_Click()
   
2. t = Timer
   
3. With Sheets("生产计划")
   
4.     生产计划 = .Range(.UsedRange.Address)
   
5. End With
   
6. With Sheets("基准表")
   
7.     基准表 = .Range(.UsedRange.Address)
   
8. End With
   
9. Dim 半成1 As Range, 部门1 As Range, 半成2 As Range, 耗材1 As Range, 单耗1 As Range
   
10. Dim r半成 As Long, r部门 As Long, c半成 As Long, c部门 As Long, r半成2 As Long, r耗材 As Long, r单耗 As Long, c半成2 As Long, c耗材 As Long, c单耗 As Long, kk As Long, k As Long, i As Long, ii As Long, ooo As Long, iii As Long
    
11. Set 半成1 = Sheets("生产计划").Range("1:5").Find("半成品")
    
12. Set 部门1 = Sheets("生产计划").Range("1:5").Find("部门名称")
    
13. Set 半成2 = Sheets("基准表").Range("1:5").Find("半成品")
    
14. Set 耗材1 = Sheets("基准表").Range("1:5").Find("耗材料号")
    
15. Set 单耗1 = Sheets("基准表").Range("1:5").Find("单耗")
    
16. 
    
17. If Not 半成1 Is Nothing Or Not 部门1 Is Nothing Or Not 半成2 Is Nothing Or Not 耗材1 Is Nothing Or Not 单耗1 Is Nothing Then
    
18.     r半成 = 半成1.Row
    
19.     r部门 = 部门1.Row
    
20.     If r半成 = r部门 Then
    
21.         c半成 = 半成1.Column
    
22.         c部门 = 部门1.Column
    
23.         Else
    
24.         MsgBox "请检 生产计划中的1到5行中是否存在半成品》部门名称 "
    
25.         Exit Sub
    
26.     End If
    
27.     r半成2 = 半成2.Row
    
28.     r耗材 = 耗材1.Row
    
29.     r单耗 = 单耗1.Row
    
30.     If r半成2 = r耗材 And r耗材 = r单耗 Then
    
31.         c半成2 = 半成2.Column
    
32.         c耗材 = 耗材1.Column
    
33.         c单耗 = 单耗1.Column
    
34.         Else
    
35.         MsgBox "请检查 基准表 中的1到5行中是否存在 半成品》》耗材料号 》单耗字段"
    
36.         Exit Sub
    
37.     End If
    
38. End If
    
39. For oo = 1 To UBound(生产计划, 2)
    
40.     If IsDate(生产计划(r半成, oo)) Then
    
41.     k = k + 1
    
42.   Sheets("标准用量").Cells(2, 7 + k) = 生产计划(r半成, oo)
    
43.     End If
    
44. Next
    
45. For ooo = 1 To UBound(生产计划, 2)
    
46.     If IsDate(生产计划(r半成, ooo)) Then
    
47.     ooo = ooo - 1
    
48.     GoTo 11
    
49.     End If
    
50. Next
    
51. 11:
    
52. ReDim 标准用量(1 To UBound(生产计划, 1), 1 To 7 + k)
    
53. For i = r半成 + 1 To UBound(生产计划, 1)
    
54.     标准用量(i - 2, 2) = 生产计划(i, c部门)
    
55.     标准用量(i - 2, 3) = 生产计划(i, c半成)
    
56.     标准用量(i - 2, 1) = "检查基准表"
    
57.     For ii = r半成2 + 1 To UBound(基准表, 1)
    
58.         If 生产计划(i, c半成) = 基准表(ii, c半成2) Then
    
59.             标准用量(i - 2, 1) = 基准表(ii, c耗材)
    
60.             For iii = 1 To k
    
61.             标准用量(i - 2, 7 + iii) = 基准表(ii, c单耗) * 生产计划(i, ooo + iii)
    
62.             Next iii
    
63.             GoTo 111
    
64.         End If
    
65.     Next
    
66. 111:
    
67. Next
    
68. Sheets("标准用量").Cells(2, 1).Resize(UBound(标准用量), UBound(标准用量, 2)).Borders.LineStyle = xlContinuous
    
69. Sheets("标准用量").Cells(3, 1).Resize(UBound(标准用量), UBound(标准用量, 2)) = 标准用量
    
70. Sheets("标准用量").Cells(3, 1).Resize(UBound(标准用量), UBound(标准用量, 2)) = 标准用量
    
71. t = Timer - t
    
72. MsgBox "耗时" & t
    
73. End Sub
    

复制代码

小白兔3399

银河懒麒麟 发表于 2023-4-28 05:22
我杂就上传不了呢

银河懒麒麟

标准用量(i - 2, 1) = "检查基准表"  
可注释掉这一句

小白兔3399

银河懒麒麟 发表于 2023-4-28 21:11
标准用量(i - 2, 1) = "检查基准表"  
可注释掉这一句

如注释掉这一句单元格就空在那里了，这不是我想要的效果哟

是我的需求表述的不清楚：


标准用量表的半成品料号和耗材的料号以及部门是手动填进去的，这个地方不要自动导入
也就是说程序只需根据我手动填入的料号，查找排产表和基准表，有匹配的上的就计划用量，没有匹配的上的，用量就填0。 麻烦老师了。
备注：基准表中，同一个半成品里面会有N个耗材料号

银河懒麒麟

是这样么？？