VBA实现小计自动向上求和

yf_home

   如附件黄色区域，VBA实现小计自动向上求和：    自动求和.zip (24.7 KB, 下载次数: 31)

2017-7-21 19:16 上传

点击文件名下载附件

.

chxw68

1. Sub tet()
   
2.   Dim r%, i%
   
3.   With Worksheets(1)
   
4.     r = .Cells(.Rows.Count, 3).End(xlUp).Row
   
5.     For i = 5 To r
   
6.       If .Cells(i, 2).MergeCells Then
   
7.         If .Cells(i, 2).MergeArea.Cells(1, 1).Address = .Cells(i, 2).Address Then
   
8.           hs = .Cells(i, 2).MergeArea.Rows.Count
   
9.           .Cells(i + hs - 1, 4).Resize(1, 21).FormulaR1C1 = "=SUM(R" & i & "C:R[-1]C)"
   
10.         End If
    
11.       End If
    
12.     Next
    
13.   End With
    
14. End Sub
    

复制代码

chxw68

详见附件。

yf_home

chxw68 发表于 2017-7-21 19:32
详见附件。

为什么这里的公式里多个锁定符号：

=SUM(D$5:D10)


.

chxw68

yf_home 发表于 2017-7-21 19:44
为什么这里的公式里多个锁定符号：

=SUM(D$5:D10)

这是绝对引用，不懂的话百度一下。

nb446835

相当强大，又学习了。

deserteaglet

我倒觉得你这张表用VBA有点大材小用了，直接用sum函数解决，而且还能动态显示结果。

chxw68

判断第3列是“小计”和“总计”写入公式更合理一些。

1. Sub test2()
   
2.   Dim r%, i%
   
3.   With Worksheets(1)
   
4.     r = .Cells(.Rows.Count, 3).End(xlUp).Row
   
5.     gs = ""
   
6.     For i = 5 To r
   
7.       If .Cells(i, 3) = "小計" Then
   
8.         hs = .Cells(i, 2).MergeArea.Rows.Count
   
9.         .Cells(i, 4).Resize(1, 21).FormulaR1C1 = "=SUM(R[" & 1 - hs & "]C:R[-1]C)"
   
10.         gs = gs & "+R" & i & "C"
    
11.       ElseIf .Cells(i, 3) = "統計" Then
    
12.         .Cells(i, 4).Resize(1, 21).FormulaR1C1 = "=" & Mid(gs, 2)
    
13.         gs = ""
    
14.       End If
    
15.     Next
    
16.   End With
    
17. End Sub
    

复制代码

chxw68

详见附件。

chengshanming

路过，不错的帖子，做个记号！