列合计

准提部林

Sub TEST3()
Dim xF As Range, TS$, TM
TM = Timer
Set xF = [a:a].Find("合计", , , xlWhole)
If xF Is Nothing Then MsgBox "找不到合计行 ": Exit Sub
With Range(xF(1, 5), Cells(4, Columns.Count).End(1)(2))
     TS = .Columns(1).Resize(.Rows.Count - 1).Address(0, 0)
     With .Rows(.Rows.Count)
          .Formula = "=sum(" & TS & ")"
          .Value = .Value
     End With
End With
MsgBox Timer - TM
End Sub

xing_chen

洋务德雷 发表于 2023-2-18 20:22
这个还需要编程吗？插入表，或者直接写公式不就可以了吗？

老师，你好！发的表时样式表。因为原表中含条件函数和跨表函数，列合计原已有公式，求助的这代码是最后一步再重算的。所以特急人，再求助的。

那时雨

使用数组、循环求和。试试看！

1. Sub Test()
   
2.     Dim arr, brr(), r&, c&, n&, m&
   
3.     arr = ActiveSheet.UsedRange
   
4.    
   
5.     For c = 5 To UBound(arr, 2) '外层循环列
   
6.         For r = 2 To UBound(arr) '内层循环行
   
7.             n = n + arr(r, c) '累加
   
8.         Next r
   
9.         ReDim Preserve brr(1 To UBound(arr, 2)) '定义动态数组存放每列累加的和
   
10.         m = m + 1 '累加
    
11.         brr(m) = n '将列累加的和赋值给数组
    
12.         n = 0  '计数器清空
    
13.     Next c
    
14.    
    
15.     Cells((UBound(arr) + 6), 1).Value = "合计"
    
16.     Cells((UBound(arr) + 6), 5).Resize(1, UBound(arr, 2)) = _
    
17.         Application.Transpose(Application.Transpose(brr))
    
18. End Sub
    

复制代码

准提部林

在11樓代碼上增修//
TT20230219-1.rar (12.79 KB, 下载次数: 3)

2023-2-19 10:16 上传

点击文件名下载附件

1) 檢查"合计行"是否存在..存在--更新//不存在--則--建立
2) 合计行與資料區空一行
3) 保留公式, 合計公式=SUM(E5:E105)+N(0)
    那個+N(0)...用來識別該公式為合計行(不影響合计值),
    當"TOTAL(合计)"字樣不存在時, 則以N(0)為找查對象.
    若兩者都不存在, 則自動加增一列合计行

xing_chen

那时雨 发表于 2023-2-19 00:50
使用数组、循环求和。试试看！

谢谢老师！运行如愿！有注释，有清晰概念。学习了！

xing_chen

准提部林 发表于 2023-2-19 10:22
在11樓代碼上增修//

谢谢老师！运行如愿！想的周全，让你费心了！速度快的多了，我将你代码弄到去年的表格里，原代码耗时7.84375，现在只化0.4375.感觉飞了。谢谢！