根据餐谱自动生成出库表

yangqianming

上次储老师给写的自动导出带量餐谱非常高级，又想着在此基础上加个自动生成出库表，那就完美了！

需求：自动提取带量食谱核算表的对应餐次品名数量单价金额到日常餐物资出库表和营养餐物资出库表，提取数据时间段是开始时间和结束时间，如果带量食谱核算表数据发生改变，开始时间和结束时间会重新指定，但提取数据只能在原来日常餐物资出库表和营养餐物资出库表后面添加，不能覆盖原来已经提取的数据，这两个表我模拟了两天数据，应该又很麻烦，辛苦各位老师们出手，谢谢！
带量餐普导出.rar (61.37 KB, 下载次数: 16)

2024-1-18 20:47 上传

点击文件名下载附件

yangqianming

数量是核算表的数量乘以就餐人数

3190496160

Sub 提取数据()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Date, r As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
rr = Array(1, "星期一", 2, "星期二", 3, "星期三", 4, "星期四", 5, "星期五")
For i = 0 To UBound(rr) Step 2
    d(rr(i)) = rr(i + 1)
Next i
With Sheets("带量食谱核算")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "带量食谱核算为空！": End
    ar = .Range(.Cells(1, 1), .Cells(r, 8))
End With
ReDim br(1 To UBound(ar), 1 To 6)
ReDim cr(1 To UBound(ar), 1 To 6)
With Sheets("日常餐物资出库表")
    ks = .[b2]
    js = .[d2]
    For i = ks To js
        xq = Application.Weekday(i, 2)
        zc = d(xq)
        For s = 2 To UBound(ar)
            If Trim(ar(s, 1)) = zc Then
                n = n + 1
                br(n, 1) = i
                br(n, 2) = ar(s, 2)
                For j = 5 To 8
                    br(n, j - 2) = ar(s, j)
                Next j
                If ar(s, 5) = "牛奶" Or ar(s, 5) = "牛肉" Then
                    zd = i & "|" & ar(s, 2) & "|" & ar(s, 5)
                    t = dc(zd)
                    If t = "" Then
                        k = k + 1
                        dc(zd) = k
                        t = k
                        cr(k, 1) = i
                        cr(k, 2) = ar(s, 2)
                        cr(k, 3) = ar(s, 5)
                        cr(k, 5) = ar(s, 7)
                    End If
                    cr(t, 4) = cr(t, 4) + ar(s, 6)
                    cr(t, 6) = cr(t, 6) + ar(s, 8)
                End If
            End If
        Next s
    Next i
    rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(rs, 1).Resize(n, UBound(br, 2)) = br
End With
With Sheets("营养餐物资出库表")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(rs, 1).Resize(k, UBound(cr, 2)) = cr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

带量餐普导出.rar (67.49 KB, 下载次数: 13)

2024-1-19 10:51 上传

点击文件名下载附件

3190496160

营养餐的提取规则不明确，代码仅供参考

yangqianming

3190496160 发表于 2024-1-19 10:51

点击按钮应该先判断带量食谱核算表的使用时限（开始时间之间结束时间，包括开始和结束时间这天，）如果物资出库表的时间在使用时限内就提取，否则提示食谱已经过期，在日常餐物资出库数据提取时要去掉餐别为营养餐的数据（这些数据在营养餐出库中提取），提取数据时数量要乘以就餐人数，因为我描述不清导致有些地方有瑕疵，应该说这个主要功能已经满足，如果时间输入比如结束输入2024/1/15，就会提示下标越界，能否给修改一下代码？谢谢！

3190496160

yangqianming 发表于 2024-1-19 13:22
点击按钮应该先判断带量食谱核算表的使用时限（开始时间之间结束时间，包括开始和结束时间这天，）如果物 ...

论坛是做义务的，所以，事先把所有需求描述清楚很重要，特别是一些关键性的细节一定要事先描述清楚的，