[已解决]求用VBA在求出小计和合计，多谢

chensir

求用VBA在求出小计和合计，多谢

一个是有规则的
一个是无规则的

见附件，多谢

最佳答案

月排行榜 / 总排行榜

爱疯

2013-7-9 11:39

Sub test1()
    test2 [a1]
    test2 [f1]
End Sub


Sub test2(rng As Range)
    Dim A, i, x, y
    A = rng.CurrentRegion
    For i = 2 To UBound(A) - 1
        If A(i, 2) <> "小计" Then
            x = x + A(i, 4)
        Else
            A(i, 4) = x: y = y + x: x = 0
        End If
    Next i
    A(UBound(A), 4) = y
    rng.Resize(i - 1, UBound(A, 2)) = A
End Sub
合计行放公式.rar (15.01 KB, 下载次数: 48)

2013-7-9 11:39 上传

点击文件名下载附件

跳转到最佳答案楼层

ppp710715

规则的可用以下代码：

1. Sub 规则小计()
   
2. Dim i As Integer
   
3. For i = 4 To 13 Step 3
   
4. Range("d" & i).Select
   
5.     ActiveCell.FormulaR1C1 = "=R[-1]C+R[-2]C"
   
6.     Next
   
7. Range("d14").Select
   
8.     ActiveCell.FormulaR1C1 = "=SUMIF(C[-2],R[-1]C[-2],C)"
   
9. End Sub

复制代码

爱疯

Sub test1()
    test2 [a1]
    test2 [f1]
End Sub


Sub test2(rng As Range)
    Dim A, i, x, y
    A = rng.CurrentRegion
    For i = 2 To UBound(A) - 1
        If A(i, 2) <> "小计" Then
            x = x + A(i, 4)
        Else
            A(i, 4) = x: y = y + x: x = 0
        End If
    Next i
    A(UBound(A), 4) = y
    rng.Resize(i - 1, UBound(A, 2)) = A
End Sub
合计行放公式.rar (15.01 KB, 下载次数: 48)

2013-7-9 11:39 上传

点击文件名下载附件

chensir

爱疯 发表于 2013-7-9 11:39
Sub test1()
    test2 [a1]
    test2 [f1]

多谢，合计如何做呢

爱疯

chensir 发表于 2013-7-9 13:03
多谢，合计如何做呢

合计行放公式2.rar (15.26 KB, 下载次数: 17)

2013-7-9 14:22 上传

点击文件名下载附件

rng.Resize(i - 1, UBound(A, 2)) = A
搞粗心了，这儿不应减1，已更正。

ppp710715

爱疯 发表于 2013-7-9 11:39
Sub test1()
    test2 [a1]
    test2 [f1]

合计为啥出不来？

chensir

爱疯 发表于 2013-7-9 11:39
Sub test1()
    test2 [a1]
    test2 [f1]

你好，问一下如果 E列再加个成绩2，代码会如何变化，

chensir

爱疯 发表于 2013-7-9 14:23
rng.Resize(i - 1, UBound(A, 2)) = A
搞粗心了，这儿不应减1，已更正。

你好，附件改了，多谢

爱疯

Sub test3()
    Dim A, i, j, s, n

    A = Range("b1:f" & Range("b65536").End(xlUp).Row)
    n = UBound(A)

    For j = 3 To UBound(A, 2)
        For i = 2 To n - 1
            If A(i, 1) <> "小计" Then
                s = s + A(i, j)
            Else
                A(i, j) = s
                A(n, j) = A(n, j) + s
                s = 0
            End If
        Next i
    Next j
   
    [b1].Resize(i, UBound(A, 2)) = A
End Sub
合计行放公式2.rar (14.24 KB, 下载次数: 42)

2013-7-11 16:55 上传

点击文件名下载附件

chensir

爱疯 发表于 2013-7-11 16:55
Sub test3()
    Dim A, i, j, s, n

多谢，多谢