按月统计收入的期初余额和本期金额

jaxpqh

　　我有一个《订单汇总》工作簿，里面有给客户送货单明细的《收入表》工作表，我要按月统计当月应收款（本期金额），至上月底应收款（期初余额），所有应收款（合计金额），因为实际上的明细有很多，请哪位大师帮我用VBA代码实现快速统计，得出结果具体如下图，在此先说声谢谢了！基本需求有以下几点：

　　一、VBA代码放一个专门的工作簿里，而不放在《订单汇总》工作簿，运行VBA代码时，不需要打开激活《订单汇总》工作簿。

　　二、导出的表格新建一个工作簿命名为“****年*月收入统计表”，工作表命名为“****年*月”，保存在命名为《统计表》的文件夹里。

　　三、运行VBA时，手动输入要统计的年月，默认为当前日期的上个月（一般是在月初统计上一个月的情况），输入年月后在运行统计，统计数据的列为“应收金额”列。

　　四、“期初余额”是指输入的年月对应“送货日期”之前某客户尚未收款的余额，已经收款（表中“已收金额”列不为空的）不作统计，“本期金额”是指输入的年月对应“送货日期”的某客户“应收金额”列之和。“期初余额”与“本期金额”之和为“合计金额”，“期初余额”与“本期金额”均无数据的客户不列出不来，比如统计“2024年3月”，客户“百迪”虽然在《收入表》有明细但都已经收款，所以在“2024年3月收入统计表”中不列出来。

shiruiqiang

其实，个人角度来说，每月反复流水，也建议走数据库，但是每月的月底固定结账一次。然后本月就从上期未清额度统计

cnmlgb9998

做了一半，不想做了。你这要按月的。

jaxpqh

cnmlgb9998 发表于 2024-3-23 14:51
做了一半，不想做了。你这要按月的。

　　还是想你能做完

jaxpqh

shiruiqiang 发表于 2024-3-23 14:27
其实，个人角度来说，每月反复流水，也建议走数据库，但是每月的月底固定结账一次。然后本月就从上期未清额 ...

　　数据库一般人都不会弄，特别是输入数据比Excel慢多了。

LIUZHU

运行VBA还不打开原始工作簿，为什么不用公式做呢？

3190496160

Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
w = InputBox("请输入要统计的年月：", "年月", Year(Date) & Format(Month(Date) - 1, "00"))
If w = "" Then End
f = Dir(lj & "订单汇总.xlsx")
If f = "" Then MsgBox "找不到订单汇总文件！": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets("收入表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "收入表为空！": End
    ar = .Range("a1:l" & r)
End With
wb.Close False
Dim br()
ReDim br(1 To UBound(ar), 1 To 5)
k = 1
rr = Array("序号", "客户名称", "期初余额", "本期金额", "合计金额")
For j = 0 To UBound(rr)
    br(k, j + 1) = rr(j)
Next j
For i = 2 To UBound(ar)
    If ar(i, 2) <> "" Then
        If IsDate(ar(i, 2)) Then
            If ar(i, 5) <> "" And ar(i, 12) = "" Then
                t = d(ar(i, 5))
                If t = "" Then
                    k = k + 1
                    d(ar(i, 5)) = k
                    t = k
                    br(k, 1) = k - 1
                    br(k, 2) = ar(i, 5)
                End If
                nf = Year(ar(i, 2)) & Format(Month(ar(i, 2)), "00")
                If nf < w Then
                    br(t, 3) = br(t, 3) + ar(i, 11)
                End If
                If nf = w Then
                    br(t, 4) = br(t, 4) + ar(i, 11)
                End If
                br(t, 5) = br(t, 3) + br(t, 4)
            End If
        End If
    End If
Next i
Application.SheetsInNewWorkbook = 1
Set ww = Workbooks.Add
With ww.Worksheets(1)
    .Name = w
    .[a1].Resize(k, UBound(br, 2)) = br
    .Cells(k + 1, 1) = "合计"
    For j = 3 To 5
        .Cells(k + 1, j) = Application.Sum(Application.Index(br, 0, j))
    Next j
    .[a1].Resize(k + 1, UBound(br, 2)).Borders.LineStyle = 1
End With
ww.SaveAs Filename:=lj & "统计表\" & w & ".xlsx"
MsgBox "ok!"
End Sub

3190496160

统计.rar (66.2 KB, 下载次数: 15)

2024-3-25 11:00 上传

点击文件名下载附件

yanglinzi

类似进销存流水账

jaxpqh

3190496160 发表于 2024-3-25 11:00

　　请帮我优化一下代码，两项都为零的客户在统计表内不列出来。下图是我将所有数据都放入收入表中后运行ＶＢＡ代码得出的结果，没有数据的客户名单也在统计表中列出来了，我的需求是不列出来。