如何修改VBA代码将连续单元格求和结果填入上方空白单元格

核心调整逻辑 #

• 行遍历方向从原有的从上到下改为从所选区域的最后一行向上遍历
• 用变量记录连续非空区域的底部行位置，遇到空白单元格时直接计算其下方连续非空区域的和填入该空白格
• 原代码的英文交互提示全部汉化
• 修复原代码变量声明不规范的问题，所有整数变量明确指定为Integer类型

修改后完整代码 #

Sub InsertTotalsReverse()
    Dim xRg As Range
    Dim i As Integer, j As Integer, EndRow As Integer, StartCol As Integer
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.AddressLocal
    Set xRg = Application.InputBox("请选择需要处理的单元格区域：", "求和工具", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    StartCol = xRg.Column
    ' 遍历每一列单独处理
    For i = StartCol To xRg.Columns.Count + StartCol - 1
        ' 初始结束行设为当前列所选区域的最后一行
        EndRow = xRg.Row + xRg.Rows.Count - 1
        ' 从下往上倒序遍历行
        For j = xRg.Row + xRg.Rows.Count - 1 To xRg.Row Step -1
            If Cells(j, i) = "" Then
                ' 空白单元格填入下方连续非空区域的求和公式
                Cells(j, i).Formula = "=SUM(" & Cells(j + 1, i).Address & ":" & Cells(EndRow, i).Address & ")"
                ' 更新结束行位置为当前空白行的上一行
                EndRow = j - 1
            End If
        Next
    Next
End Sub

使用说明 #

运行代码后会弹出选区确认框，选中你需要处理的单元格区域点击确定即可，代码会自动在每一个空白单元格中填入其下方连续非空单元格的求和公式，不会修改原有数值内容。

内容的提问来源于stack exchange，提问作者Tony Tiger