如何根据出库底单生成各天的出库表

袁勇

定敏 发表于 2024-12-25 11:56
您看，这个表成了断开的了，能不能连起来？而且，显示的菜名也不完全，像23号午餐，应该“猪肉,牛肉,青 ...

不存在这种情况。

定敏

袁勇 发表于 2024-12-25 12:03
不存在这种情况。

怪了，可是，我这里是这样显示的：

meiya

之前的是我看错列了，已更正

溺水鱼

1. =IFERROR(LET(a,OFFSET(INDEX(出库底单!2:2,MATCH(C2,出库底单!2:2,)),2,,29,4),b,IFNA(VSTACK(FILTER(a,TAKE(a,,-1)="午"),{"大米","斤";"菜油","斤";"辣椒","斤";"盐","包"}),""),HSTACK(EXPAND(CHOOSECOLS(b,1),,3,""),DROP(b,,1))),"")

复制代码

溺水鱼

1. =IFERROR(LET(a,OFFSET(INDEX(出库底单!2:2,MATCH(C2,出库底单!2:2,)),2,,29,4),b,IFNA(VSTACK(FILTER(a,TAKE(a,,-1)="晚"),{"大米","斤";"菜油","斤";"辣椒","斤";"盐","包"}),""),HSTACK(EXPAND(CHOOSECOLS(b,1),,3,""),DROP(b,,1))),"")

复制代码

溺水鱼

忘记调大行数了，如果出库底单里记录的数据超过32行数据的话，OFFSET里的29改大一点就可以了，你自己调一下吧

meiya

定敏 发表于 2024-12-25 11:47
是我当初没有合并好表头，导致你们误解了，应该像这样，表头全部，餐别标记就跟在当天的数量之后，而且， ...

是的，我误以为餐别在每日的首列，所以给22日加了一列餐别。经你提醒后，已调整公式并重新上传一份，在23楼

定敏

meiya 发表于 2024-12-25 14:19
是的，我误以为餐别在每日的首列，所以给22日加了一列餐别。经你提醒后，已调整公式并重新上传一份，在23 ...

已经很好了，感谢您帮了我大忙。

3190496160

Sub 台账()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("出库底单")
    r = .Cells.Find("*", searchdirection:=xlPrevious).Row
    y = .Cells(4, Columns.Count).End(xlToLeft).Column
    If r < 5 Then MsgBox "出库底单工作表为空！": End
    ar = .Range(.Cells(2, 1), .Cells(r, y))
End With
For j = 4 To UBound(ar, 2) - 3 Step 4
    If ar(1, j - 3) <> "" Then
        For i = 3 To UBound(ar)
            If ar(i, j) <> "" Then
                s = ar(1, j - 3) & "|" & ar(i, j)
                If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
                dc(s) = j
                d(s)(i) = ""
            End If
        Next i
    End If
Next j
rr = Array("大米", "菜油", "辣椒", "盐巴")
With Sheets("营养餐出库台账")
    With .UsedRange.Offset(4)
        .ClearContents
        .UnMerge
        .Borders.LineStyle = 0
    End With
    rs = 1
    For Each k In d.keys
        n = 0: w = w + 1
        ReDim br(1 To d(k).Count + 4, 1 To 9)
        lh = dc(k)
        For Each kk In d(k).keys
            n = n + 1
            br(n, 1) = n
            br(n, 2) = ar(kk, lh - 3)
            br(n, 5) = ar(kk, lh - 2)
            br(n, 6) = ar(kk, lh - 1)
            br(n, 8) = "仟山农户产品运营有限公司"
            rq = ar(1, lh - 3)
            cb = ar(kk, lh)
        Next kk
        For i = 0 To UBound(rr)
            n = n + 1
            br(n, 1) = n
            br(n, 2) = rr(i)
            If rr(i) = "盐巴" Then
                br(n, 5) = "包"
            Else
                br(n, 5) = "斤"
            End If
            br(n, 8) = "仟山农户产品运营有限公司"
        Next i
        If w = 1 Then GoTo 10
        .Rows("1:4").Copy .Cells(rs, 1)
10:
        .Cells(rs + 1, 2) = rq
        .Cells(rs, 1) = "2024年秋季学生营养改善计划食品出库台账（" & cb & "）"
        .Cells(rs + 4, 1).Resize(n, UBound(br, 2)) = br
        .Cells(rs + 4, 1).Resize(20, 15).Borders.LineStyle = 1
        .Rows(rs & ":" & rs + 23).RowHeight = 21
      rs = rs + 24
    Next k
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

增加了你所说的项目，
工作簿11.rar (45.12 KB, 下载次数: 1)

2024-12-26 15:00 上传

点击文件名下载附件