日报汇总到月报中

babaymum

爱疯 发表于 2020-1-13 09:46
Sub test()
    Dim A, d, i, j, k, y
    A = Sheets(2).Range("a1").CurrentRegion

您好！感谢您的及时和积极回复
       可能我说的意思不明确，效果弄反了。
我是想：
   把月份里的前日库存导入到【汇总表】里的前日【存】的位置
这样做的理由是：
   有前日库【存】 + 当日【入】-当日【出】=当日【库存】
就是完整的一张 当日仓库日报
  当日【入】、【出】的数是从数据库里自动提取出来的，所以就差前日【存】
要是也可以从相应的【月】里自动填入就好了。

爱疯

Option Explicit

Sub test()
    Dim A, d, i, j, k, y


    '1）key是品名+项目，item是行
    A = Sheets(2).Range("a1").CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(A)
        If A(i, 1) = "" Then A(i, 1) = A(i - 1, 1)
        d(A(i, 1) & A(i, 2)) = i
    Next


    '2）清除提示，并求前日y
    Sheets(1).Select
    Range("a:a").Replace "~?", ""
    A = Range("a1").CurrentRegion
    y = IIf(A(2, 5) = 1, DateSerial(Year(Date), A(2, 4), 0), A(2, 5) - 1)


    '3）表名是月，行是item，列是某日
    For i = 4 To UBound(A)

        '3-1 从每月写入到汇总
        k = A(i, 2) & A(3, 3)
        A(i, 3) = Sheets(A(2, 4) & "月").Cells(d(k), A(2, 5) + 2)

        '3-2 从汇总写入到每月
        For j = 4 To UBound(A, 2) - 1
            k = A(i, 2) & A(3, j)
            If d.exists(k) Then
                Sheets(A(2, 4) & "月").Cells(d(k), A(2, 5) + 3) = A(i, j)
            Else
                A(i, 1) = A(i, 1) & "?": Exit For
            End If
        Next

    Next


    '4）如果没有 品名+项目，则序号后面有问号
    [a1].Resize(UBound(A), UBound(A, 2)) = A
End Sub


出入库日报填入6.rar (51.14 KB, 下载次数: 14)

2020-1-13 14:50 上传

点击文件名下载附件

这样吗？

babaymum

爱疯 发表于 2020-1-13 14:51
Option Explicit

Sub test()

好感动！老师顾及到我的水平，还帮我把步骤分好，注释清楚。
效果完美展现！！！！

爱疯

没什么，这样好查看和修改些