如何一键生成各日出库单

定敏

3190496160 发表于 2023-2-16 17:16
下班了，很多细节未考虑，代码仅供参考

非常感谢，已经很好了，生成了那么多的页数，但从第二页开始，有了两个标题栏，还有每一页的每一项菜的金额都是0元，合计也不对，能不能再麻烦您有空修一下？谢谢

3190496160

book.rar (158.64 KB, 下载次数: 9)

2023-2-18 11:12 上传

点击文件名下载附件

3190496160

解决了标题重复的问题，其他的不知道你说的是什么意思

定敏

3190496160 发表于 2023-2-18 11:12
解决了标题重复的问题，其他的不知道你说的是什么意思

如图所示，金额那一列，所有的都是0，还有合计的金额，每一张都是1267.20元，而正确的应该是这个图片的结果， 您看看，能不能再修改一下，谢谢啰。

3190496160

Sub 出库单()
Application.ScreenUpdating = False
With Sheets("出库单")
    lx = Mid(.[i1], 2, Len(.[i1]) - 3)
    mc = lx & "出库登记表"
    With Sheets(mc)
        r = .Cells(Rows.Count, 3).End(xlUp).Row
        ar = .Range("a1:am" & r)
    End With
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs > 16 Then .Rows("17:" & rs).Delete
    For j = 5 To 35
        n = 0
        ReDim br(1 To UBound(ar), 1 To 5)
        If Trim(ar(2, j)) <> "" Then
            For i = 8 To UBound(ar)
                If Trim(ar(i, j)) <> "" Then
                    n = n + 1
                    br(n, 1) = Replace(ar(i, 3), "上月结余", "")
                    br(n, 2) = ar(i, 38)
                    br(n, 3) = ar(i, j)
                    br(n, 4) = ar(i, 39)
                    br(n, 5) = br(n, 3) * br(n, 4)
                End If
            Next i
            If n > 0 Then
                m = m + 1
                If m = 1 Then
                    .[c2] = ar(2, j)
                    .[g2] = ar(6, j)
                    .[i2] = ar(5, j)
                    .[l2] = ar(4, j)
                    If n <= 10 Then
                        .[b4].Resize(n, 5) = br
                    Else
                        k = 3
                        For i = 1 To 10
                            k = k + 1
                            For jj = 1 To 5
                                .Cells(k, jj + 1) = br(i, jj)
                            Next jj
                        Next i
                        k = 3
                        For i = 11 To n
                            k = k + 1
                            For jj = 1 To 5
                                .Cells(k, jj + 7) = br(i, jj)
                            Next jj
                        Next i
                    End If
                ElseIf m > 1 Then
                    ws = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Rows("1:16").Copy .Cells(ws, 1)
                    .Cells(ws + 1, 3) = ar(2, j)
                    .Cells(ws + 1, 7) = ar(6, j)
                    .Cells(ws + 1, 9) = ar(5, j)
                    .Cells(ws + 1, 12) = ar(4, j)
                    If n <= 10 Then
                        .Cells(ws + 3, 2).Resize(n, 5) = br
                    Else
                        k = ws + 2
                        For i = 1 To 10
                            k = k + 1
                            For jj = 1 To 5
                                .Cells(k, jj + 1) = br(i, jj)
                            Next jj
                        Next i
                        k = ws + 2
                        For i = 11 To n
                            k = k + 1
                            For jj = 1 To 5
                                .Cells(k, jj + 7) = br(i, jj)
                            Next jj
                        Next i
                    End If
                End If
            End If
        End If
    Next j
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

book.rar (172.37 KB, 下载次数: 6)

2023-2-21 09:38 上传

点击文件名下载附件

定敏

3190496160 发表于 2023-2-21 09:38

谢谢，接近要求了，只是还有两个小问题：1是第一张应该是上个月结余的，怎么生成的品种名称不对？（应该是您为了和其他一致，把“上个月结余”几个字去掉了，其实是不必去掉的）；2是有18号和25这两天的记录与事实不符，怎么有两个菜油的单子，麻烦您这么多了，真不好意思，但为了问题能解决，只好一事不烦二主了，再次表示万分感谢。   

3190496160

求助不是像你这般挤牙膏的，论坛是做义务的，没有人愿意在一个问题上反复折腾的，特别是没有任何技术提升的问题，

定敏

    我也没想到这个问题会折腾你这么久，更没想到会把你折腾出脾气来，既然如此，那就算了吧，但无论如何，我要感谢你的帮助。