求助老师个关于汇总的问题

qiujianxin

图片中这种数据格式，我想根据A列的每一项对C列和D列求和：比如2020/10/08结束后在下面汇总个和，然后2020/10/09、2020/10/10每一项都是这样，应该怎么写呢，谢谢！数据有很多行，附件中我只是列了几行举了个列子。

小花鹿

你这个和放哪里呢                                                                                                

笨鸟飞不高

Sub AwTest()
    Dim i&, s1, s2, arr
    arr = Range("A1:F" & Cells(Rows.Count, 2).End(3).Row + 1)
    For i = 2 To UBound(arr) - 1
        s1 = s1 + arr(i, 3): s2 = s2 + arr(i, 4)
        If Len(arr(i + 1, 1)) Then arr(i, 5) = s1: arr(i, 6) = s2: s1 = 0: s2 = 0
    Next
    If s1 <> 0 Then arr(UBound(arr) - 1, 5) = s1
    If s2 <> 0 Then arr(UBound(arr) - 1, 6) = s2
    Range("A1:F" & Cells(Rows.Count, 2).End(3).Row + 1) = arr
End Sub

笨鸟飞不高

test30.zip (14.82 KB, 下载次数: 6)

2020-10-30 12:10 上传

点击文件名下载附件

cjc209

这种收工简单操作就搞定了

笨鸟飞不高

Sub AwTest()
    Dim i&, j%, r&, s1, s2, arr
    arr = Range("A1:D" & Cells(Rows.Count, 2).End(3).Row + 1)
    ReDim brr(1 To UBound(arr) * 2, 1 To UBound(arr, 2))
    For i = 2 To UBound(arr) - 1
        s1 = s1 + arr(i, 3): s2 = s2 + arr(i, 4)
        r = r + 1
        For j = 1 To UBound(arr, 2)
            brr(r, j) = arr(i, j)
        Next
        If Len(arr(i + 1, 1)) Then r = r + 1: brr(r, 3) = s1: brr(r, 4) = s2: s1 = 0: s2 = 0
    Next
    If s1 <> 0 Or s2 <> 0 Then r = r + 1: brr(r, 3) = s1: brr(r, 4) = s2
    [f2].Resize(r, 4) = brr
End Sub

笨鸟飞不高

test30.zip (16.05 KB, 下载次数: 11)

2020-10-30 12:21 上传

点击文件名下载附件

合计在下面

qiujianxin

笨鸟飞不高 发表于 2020-10-30 12:21
合计在下面

谢谢老师，就是这个意思，有没有办法还放在原来的A列到D列的位置呢？不用放后面

准提部林

Sub Test_A1()
Dim Arr, Brr, i&, j%, N&, S(4)
Arr = Range([A1], Cells(Rows.Count, 2).End(3)(2, 3))
ReDim Brr(1 To UBound(Arr) * 2, 1 To 4)
For i = 2 To UBound(Arr) - 1
    N = N + 1
    For j = 1 To 4
        Brr(N, j) = Arr(i, j): S(j) = S(j) + Val(Arr(i, j))
    Next j
    If Arr(i + 1, 1) <> "" Or i = UBound(Arr) - 1 Then
       N = N + 1: Brr(N, 3) = S(3): Brr(N, 4) = S(4)
       Brr(N, 2) = "Total": S(3) = 0: S(4) = 0
    End If
Next i
[F2].Resize(N, 4) = Brr
End Sub

笨鸟飞不高

qiujianxin 发表于 2020-10-30 13:11
谢谢老师，就是这个意思，有没有办法还放在原来的A列到D列的位置呢？不用放后面

Sub AwTest()
    Dim i&, j%, r&, s1, s2, arr
    arr = Range("A1:D" & Cells(Rows.Count, 2).End(3).Row + 1)
    ReDim brr(1 To UBound(arr) * 2, 1 To UBound(arr, 2))
    For i = 2 To UBound(arr) - 1
        s1 = s1 + arr(i, 3): s2 = s2 + arr(i, 4)
        r = r + 1
        For j = 1 To UBound(arr, 2)
            brr(r, j) = arr(i, j)
        Next
        If Len(arr(i + 1, 1)) Then r = r + 1: brr(r, 2) = "合计": brr(r, 3) = s1: brr(r, 4) = s2: s1 = 0: s2 = 0
    Next
    If s1 <> 0 Or s2 <> 0 Then r = r + 1: brr(r, 2) = "合计": brr(r, 3) = s1: brr(r, 4) = s2
    [a1].CurrentRegion.Offset(1) = ""
    [a2].Resize(r, 4) = brr
End Sub