自动求和的 VBA 等效功能

Question

VBA 中是否有与 Alt+=（自动求和）等效的函数来对连续的数字块求和？

我尝试过使用 SendKeys "%=" 但这只会给出 SUM() 而没有引用。

编辑：我有多行数据，后面跟着两行空白行，我想在每组数据下方添加一个总和。

Amount Description  
500 Text1  
500 Text2  
SUM HERE OF AMOUNT  

600 Text1  
600 Text2  
600 text3  
SUM HERE OF AMOUNT  

Answer 1

您可以使用这些 VBA 宏作为标准模块：

Sub AutoSumRange()
 Dim lCell As Range
 Set lCell = Range("A1").End(xlDown).Offset(1, 0) 

 With Sheet1
 lCell.Formula = WorksheetFunction.Sum(Range(Range("A1"), Range("A1").End(xlDown)))
 End With
End Sub

注意：

• 此宏将把SUM最后一行/最后一列的单元格放入A（假设你有价值A2:A5，那么在A6等等) 并在插入时调整每个新值。
• 单元格 A1 有标题值。

---

編輯：

添加此 VBA 代码，因为读者的观察表明在最后一个单元格和宏中应用SUM公式应该像键盘快捷键一样工作。

Sub Test()
    Dim Rng As Range
    Dim c As Range
    Set Rng = Range("N1:N" & Range("N1").End(xlDown).Row)
    Set c = Range("N1").End(xlDown).Offset(1, 0)
    c.Formula = "=SUM(" & Rng.Address(False, False) & ")"
End Sub

---

注意：

• 创建键盘快捷键R联合国宏观。

• 在上述代码中，工作表名称和单元格引用是可编辑的。

Answer 2

这是一个与您的测试数据一起工作的 Sub：

Sub AutoSumColumn()
    Dim rngToSum As Range
    Dim TopCell As Range
    Dim BottomCell As Range

    Set rngToSum = Intersect(Selection.EntireColumn, ActiveSheet.UsedRange)
    Set TopCell = rngToSum.Cells(1, 1)
    If TopCell.Value = vbNullString Then
        Set TopCell = TopCell.End(xlDown)
    End If
    Do
        Set BottomCell = TopCell.End(xlDown)
        BottomCell.Offset(1, 0).Formula = "=sum(" & Range(TopCell, BottomCell).Address & ")"
        Set TopCell = BottomCell.Offset(1, 0).End(xlDown)
    Loop Until Intersect(rngToSum, TopCell) Is Nothing
End Sub

怎么运行的：

• 选择要添加自动求和的列中的任意单元格
• 启动宏

然后，宏会为每个连续范围创建求和公式。它还会包含对文本字段的引用，但不会影响结果。

运行宏后的工作表：