自作财务系统，明细账显示问题，求大神帮忙解决问题

falcongq

问题描述：

求助大神，这是枣园村一年的流水，希望大神能在B列到I列显示出一年的流水，要求：每月账目列出来，同时进行借贷汇总和年累计！

3190496160

Sub 分类账()
Application.ScreenUpdating = False
Dim ar As Variant, cr As Variant
Dim i As Long, r As Long, rs As Long
Dim br(), brr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
    r = .Cells(Rows.Count, 11).End(xlUp).Row
    ar = .Range("k7:r" & r)
    ReDim brr(1 To UBound(ar) + 200, 1 To 8)
    n = n + 1
    brr(n, 1) = 1
    brr(n, 2) = 1
    brr(n, 6) = "期初余额"
    brr(n, 8) = ar(1, 8)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(ar(i, 1)) = ""
        End If
    Next i
    For Each k In d.keys
         hj_1 = 0: hj_2 = 0
        For i = 2 To UBound(ar)
            If ar(i, 1) = k Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    brr(n, j) = ar(i, j)
                Next j
                hj_1 = hj_1 + ar(i, 6)
                hj_2 = hj_2 + ar(i, 7)
                zj_1 = zj_1 + ar(i, 6)
                zj_2 = zj_2 + ar(i, 7)
            End If
        Next i
        n = n + 1
        brr(n, 5) = "本月合计"
        brr(n, 6) = hj_1
        brr(n, 7) = hj_2
        brr(n, 8) = 0
        n = n + 1
        brr(n, 5) = "本年合计"
        brr(n, 6) = zj_1
        brr(n, 7) = zj_2
        brr(n, 8) = 0
    Next k
    rs = .Cells(Rows.Count, 2).End(xlUp).Row
    If rs >= 7 Then .Range("b7:i" & rs) = Empty
    .[b7].Resize(n, UBound(brr, 2)) = brr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

求助.rar (55.52 KB, 下载次数: 29)

2023-5-11 14:58 上传

点击文件名下载附件

falcongq

非常感谢大神帮助，有没有用公式做的！

3190496160

falcongq 发表于 2023-5-11 16:43
非常感谢大神帮助，有没有用公式做的！

公式是不可能完成你这样的需求的。为啥一定要追求公式呢？？？

falcongq

大神，这个表格有格式等一系列的要求。谢谢大神的帮助，公式可以的。