求助如何分年度统计

月落天涯

求大神帮忙做分年度统计，具体要求是：在月度及季度统计表B1单元格输入年度后，点击按钮，自动得出所有物料该年度各月度，季度及年度的入库，出库，结存数量。本月结存=上月结存+本月入库-本月出库，季度及年度结存同理。明细表是数据源，表中有多种物料，而不是一种。表中模拟的是2022年度。鲜花送大神，有劳各位。

grf1973

需要比较细致地对应好月份、季度和结果表列的关系。

grf1973

代码中间重复的一段用循环简化了一下，不过不是很直观，不建议修改。

ivccav

成品.zip (34.32 KB, 下载次数: 17)

2023-1-6 10:37 上传

点击文件名下载附件

蓝桥玄霜

成品的例子：

3190496160

Sub 年度统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("明细")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    If r < 3 Then MsgBox "明细为空！": End
    ar = .Range("a3:j" & r)
End With
With Sheets("月度及季度统计")
    .UsedRange.Offset(4).Borders.LineStyle = 0
    .UsedRange.Offset(4) = Empty
    h = UBound(ar)
    br = .Range("a3:bb" & h)
    nd = .[b1]
    For j = 4 To UBound(br, 2) Step 3
        If Trim(br(1, j)) <> "" Then
            d(br(1, j)) = j
        End If
    Next j
    k = 2
    For i = 2 To UBound(ar)
        If Trim(ar(i, 5)) <> "" Then
            If IsDate(ar(i, 5)) Then
                nf = Val(Year(ar(i, 5)))
                yf = Val(Month(ar(i, 5)))
                If yf <= 3 Then
                    jd = 1 & "季度"
                ElseIf yf > 3 And yf <= 6 Then
                    jd = 2 & "季度"
                ElseIf yf > 6 And yf <= 9 Then
                    jd = 3 & "季度"
                ElseIf yf > 9 And yf <= 12 Then
                    jd = 4 & "季度"
                End If
                lh = d(yf)
                lh_1 = d(jd)
                If nf = nd Then
                    zd = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
                    t = d(zd)
                    If t = "" Then
                        k = k + 1
                        d(zd) = k
                        t = k
                        For j = 2 To 4
                            br(k, j - 1) = ar(i, j)
                        Next j
                    End If
                    br(t, lh) = br(t, lh) + ar(i, 6)
                    br(t, lh_1) = br(t, lh_1) + ar(i, 6)
                    br(t, 52) = br(t, 52) + ar(i, 6)
                End If
            End If
        End If
        If Trim(ar(i, 7)) <> "" Then
            If IsDate(ar(i, 7)) Then
                nf = Val(Year(ar(i, 7)))
                yf = Val(Month(ar(i, 7)))
                If yf <= 3 Then
                    jd = 1 & "季度"
                ElseIf yf > 3 And yf <= 6 Then
                    jd = 2 & "季度"
                ElseIf yf > 6 And yf <= 9 Then
                    jd = 3 & "季度"
                ElseIf yf > 9 And yf <= 12 Then
                    jd = 4 & "季度"
                End If
                lh = d(yf)
                lh_1 = d(jd)
                If nf = nd Then
                    zd = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
                    t = d(zd)
                    If t = "" Then
                        k = k + 1
                        d(zd) = k
                        t = k
                        For j = 2 To 4
                            br(k, j - 1) = ar(i, j)
                        Next j
                    End If
                    br(t, lh + 1) = br(t, lh + 1) + ar(i, 8)
                    br(t, lh + 2) = br(t, lh) - br(t, lh + 1)
                    br(t, lh_1 + 1) = br(t, lh_1 + 1) + ar(i, 8)
                    br(t, lh_1 + 2) = br(t, lh_1) - br(t, lh_1 + 1)
                    br(t, 53) = br(t, 53) + ar(i, 8)
                    br(t, 54) = br(t, 2) - br(t, 53)
                End If
            End If
        End If
    Next i
    If k = "" Then MsgBox "明细中没有" & nd & "的数据！": End
    .[a3].Resize(k, UBound(br, 2)) = br
    .[a3].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "统计完毕！"
End Sub

3190496160

成品.rar (50.43 KB, 下载次数: 16)

2023-1-6 11:04 上传

点击文件名下载附件

3190496160

时间仓促，代码没有细致打磨，仍欠简洁，不过，很直观，对于初学者倒是很容易看懂

LIUZHU

明细这张表，日期为什么不设置成1列，非要搞一个入库日期，出库日期？

LIUZHU

用JS宏做，代码没有那么恐怖