[已解决]VBA求助：材料申购计划

mxg825 · 发表于 2011-10-24 17:57

本帖最后由 mxg825 于 2011-10-24 20:15 编辑

加了2003 2007版自动识别！
申购数量，以系统日期为准！（当天）

绝峰 · 发表于 2011-10-25 09:04

谢谢！
还欠：“申购单打印”只要输入某一天日期，这一日所需申购的材料及数量都要显示出来

绝峰 · 发表于 2011-10-25 14:23

回复 mxg825 的帖子

“申购单打印”只要输入某一天日期，这一日所需申购的材料及数量都要显示出来

材料申购计划(2).rar (25.11 KB, 下载次数: 11)

mxg825 · 发表于 2011-10-25 22:59

这个最佳答案由 mxg825 给出，感谢 mxg825 的回答。

单击隐藏图章

本帖最后由 mxg825 于 2011-10-26 16:40 编辑

回复绝峰的帖子

有了这个按日期生成申请查询单,
第一个程序本人认为没有意义了!

昨晚花了2个小时才把代码写好！
2011-10-26 17：00代码更正好请重新下载！

Sub 当天申购单()
Dim D As New Dictionary '建立字典 (主键 key 值（产品名称&类别），Item值（D数组的行号字符串）
Dim ID As New Dictionary '建立字典(主键 key 值（材料代码），Item值（CARR 列号）
Dim Aarr, Barr, Carr(), Darr
'Aarr ：申购表详细数据 (下简称A数组）
'Barr ：字典D 的 Item值字符串转换成数组 (下简称B数组）
'Carr()：申购单打印生成数据的数组，随需要可增加列数（也就是不够就增加）(下简称C数组）
'Darr ：明细表详细数据（产品用料用量表）(下简称D数组）
Dim X&, Y&, K& '循环体的变量
Dim MYdate As Date '把[B2]的值交给一个日期变量
Dim CCOL&, DCOL& 'C数组的行号，D 数组的行号
If Not IsDate([B2]) Then MsgBox "[B2]输入非日期格式", , "中止": Exit Sub
Application.ScreenUpdating = False '关闭刷新提高速度
Sheets("申购单打印").Range("a4:F" & Sheets("申购单打印").Range("a65536").End(xlUp).Row + 1).Clear '清空旧数据
On Error Resume Next '忽略出错
Aarr = Sheets("申购表").Range("a4:D" & Sheets("申购表").Range("a65536").End(xlUp).Row) 'A数组赋值
Darr = Sheets("明细表").Range("a3:G" & Sheets("明细表").Range("a65536").End(xlUp).Row) 'D数组赋值
MYdate = [B2] '日期变量赋值
For X = 1 To UBound(Darr) '循环D数组建立D字典，
D(Darr(X, 1) & Darr(X, 2)) = D(Darr(X, 1) & Darr(X, 2)) & X & ","
'主键 key 值（产品名称&类别）=Item值（该主健对应的D数组行号串联，也就是每个产品用料的行号字符串【，】分隔符号）
Next
For X = 1 To UBound(Aarr) '循环A数组
If Aarr(X, 1) = MYdate Then '对比日期
Barr = Split(D(Aarr(X, 2) & Aarr(X, 3)), ",") '字典D 的 Item值字符串转换成数组（每个产品对应的材料的行号）
For Y = 0 To UBound(Barr) - 1 '循环B数组
DCOL = Barr(Y) '每个产品对应的材料的行号交给变量
If ID.Exists(Darr(DCOL, 3)) Then '查看 ID 字典是否存在这个【材料代码】
CCOL = ID(Darr(DCOL, 3)) '存在：取这个材料在 C 数组中的列号！
Carr(5, CCOL) = Carr(5, CCOL) + Darr(DCOL, 7) * Aarr(X, 4) '材料数量累加
Carr(6, CCOL) = Carr(6, CCOL) & "／" & Aarr(X, 2) & Left(Aarr(X, 3), 1) & "=" & _
Darr(DCOL, 7) * Aarr(X, 4) & Darr(DCOL, 6) '备注信息（串联了下方备注信息）
Else '不存在
K = K + 1 '加一列
ID(Darr(DCOL, 3)) = K '字典ID 新添一个！'主键 key 值（材料代码）=Item值（C数组所在列号）
ReDim Preserve Carr(1 To 6, 1 To K) 'Carr数组增加一列
Carr(1, K) = Darr(DCOL, 3) '材料代码
Carr(2, K) = Darr(DCOL, 4) '材料名称
Carr(3, K) = Darr(DCOL, 5) '规格
Carr(4, K) = Darr(DCOL, 6) '单位
Carr(5, K) = Darr(DCOL, 7) * Aarr(X, 4) '材料用量* 产品套数
Carr(6, K) = Aarr(X, 2) & Left(Aarr(X, 3), 1) & "=" & Darr(DCOL, 7) * Aarr(X, 4) & Darr(DCOL, 6)
'备注信息= 产品名称 &产品规格（"单人位"，截取为“单”) & "=" & 材料用量* 产品套数 & 单位
End If
Next Y
End If
Next X
With Sheets("申购单打印").Range("A4").Resize(K, 6)
.Value = Application.Transpose(Carr) 'C数组导到工作表
.Sort key1:=Columns("A") '排序
.Borders.LineStyle = 1 '加网格线
End With
Application.ScreenUpdating = True '开启刷新
MsgBox "需要申购材料共有" & K & "种", , "MXG825提示"
End Sub

复制代码

注释写这么清楚应该能看懂了吧？

绝峰 · 发表于 2011-10-26 09:27

非常感谢！！

绝峰 · 发表于 2011-10-26 09:29

能否帮我把每段代码写上标注？以便学习之用！

yeshuangyong · 发表于 2011-10-26 09:51

非常感谢！！

mxg825 · 发表于 2011-10-26 12:03

绝峰发表于 2011-10-26 09:29
能否帮我把每段代码写上标注？以便学习之用！

24楼补上了注释说明！

yangkd · 发表于 2011-10-26 13:11

回复 mxg825 的帖子

老师辛苦了，虽然不懂代码，看看设计运算结果，
费心了。{:35:}

绝峰 · 发表于 2011-10-26 18:02

辛苦了，谢谢！！

		自动登录	找回密码
密码			注册

[已解决]VBA求助：材料申购计划

评分