求助大佬，分类汇总还有按日期小计问题，万分感谢！

dj530116

求助大佬，分类汇总还有按日期小计问题

3190496160

总()
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("源数据表")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:h" & rs)
End With
With Sheets("日报表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r > 3 Then
        .Range("a4:i" & r).Borders.LineStyle = 0
        .Range("a4:i" & r) = Empty
    End If
    br = .Range("a3:i" & rs)
    For j = 3 To UBound(br, 2) - 2
        If Trim(br(1, j)) <> "" Then
            d(Trim(br(1, j))) = j
        End If
    Next j
    k = 1
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
            zf = ar(i, 1) & "|" & Trim(ar(i, 2))
            t = d(zf)
            If t = "" Then
                k = k + 1
                d(zf) = k
                t = k
                br(k, 1) = ar(i, 1)
                br(k, 2) = ar(i, 2)
            End If
            lh = d(Trim(ar(i, 3)))
            If lh <> "" Then
                 br(t, lh) = br(t, lh) + ar(i, 8)
            End If
        End If
    Next i
    For i = 2 To k
        For j = 3 To UBound(br, 2) - 2
            If br(i, j) = "" Then br(i, j) = 0
            br(i, 8) = br(i, 8) + br(i, j)
        Next j
    Next i
    .[a3].Resize(k, UBound(br, 2)) = br
    .[a3].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"

End Sub

3190496160

求助.rar (22.86 KB, 下载次数: 13)

2022-1-6 07:51 上传

点击文件名下载附件

3190496160

小计  自己用公式搞定吧

dj530116

其实关键就是小计那个搞不懂了

dj530116

3190496160 发表于 2022-1-6 08:01
小计  自己用公式搞定吧

其实关键就是小计那个搞不懂咋弄了，要每天的下面一行加小计和公式

3190496160

dj530116 发表于 2022-1-6 08:33
其实关键就是小计那个搞不懂咋弄了，要每天的下面一行加小计和公式

如果汇总你能够搞定，那么小计也一定能够搞定，以为，汇总就如早航天飞机，而小计就如造一个小孩玩具模型飞机

small_small

试试这个可以不

opel-wong

dj530116 发表于 2022-1-6 08:33
其实关键就是小计那个搞不懂咋弄了，要每天的下面一行加小计和公式

变通一下，也可以实现的。
代码如下，供参考：

opel-wong

自动添加边框，小计行与合计行的颜色填充，
执行后效果图：