批量添加SUM求和公司

443147055

我有一张超级大的数据表，需要添加求和公式，如下图

我的想法是选择当前列的时候，会自动判断，遇到空格就把上一个空格与当前空格之间的单元格求和。如上图，执行代码后，会批量在E7、E11添加如图所示的求和公式。因为表格很大，且涉及内部资料不方便上传，我只是举了个示例。请各位高手给出出主意。我自己的水平有点菜，解决不了。

liulang0808

楼主上传一个模拟附件。，结合附件说明下需求吧

443147055

我刚上传了附件，如图1。因为一个在大型工程的竣工决算表中需要对不同分组添加求和公式，我想要达到的目的是遇到空格就对空格以上的区域添加SUM公式，不是直接求值，因为数值可以会进行调整。

liulang0808

Sub 按钮1_Click()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Set ad = Nothing
    For j = 3 To Cells(Rows.Count, 5).End(3).Row + 1
        If Len(Cells(j, 5)) > 0 Then
            If ad Is Nothing Then
                Set ad = Cells(j, 5)
            End If
        Else
            Cells(j, 5) = "=sum(" & Range(ad, Cells(j - 1, 5)).Address & ")"
            Set ad = Nothing
        End If
    Next j
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

443147055

liulang0808 发表于 2021-3-6 08:39
Sub 按钮1_Click()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False

谢谢，达到我的效果了，我再按照我的数据格式改一下应该就可以了，谢谢

zjzyj

Sub ttt()
    s = 3
    For i = s To Cells(Rows.Count, "E").End(3).Row + 1
        If Cells(i, "E") = "" Then
            Cells(i, "E").FormulaR1C1 = "=SUM(R[" & s - i & "]C:R[-1]C)"
            s = i + 1
        End If
    Next
End Sub