求助SUM求和用VBA替代

dengcaimao

请教老师，I列等于G列+H列，我用下面的VBA生成时，把I列前面的有公式列的公式全部转化为数值了，请教怎么修改？

Sub 合同动态结算金额求和()

    Worksheets("合同明细").Range("i4:i2000").ClearContents

    arr = [a1].CurrentRegion

    For i = 4 To UBound(arr)

        S = 0

        For j = 7 To 8

            If IsNumeric(arr(i, j)) Then S = S + arr(i, j)

        Next

        arr(i, 9) = S

    Next

    [a1].CurrentRegion = arr

End Sub

用下面的VBA求和时，行很多时计算超慢

Sub 合同动态结算金额求和1()

    Dim lastrA%, i

        lastrA = Sheets("合同已付明细").Cells(Rows.Count, 2).End(xlUp).Row

        For i = 4 To lastrA

        Cells(i, 9) = Application.Sum(Range(Cells(i, 7), Cells(i, 8)))

    Next i

End Sub

山菊花

Sub 合同动态结算金额求和()
    Dim Arr(), Brr()
    Worksheets("合同明细").Range("i4:i2000").ClearContents
    Arr = [a1].CurrentRegion.Value
    ReDim Brr(4 To UBound(Arr), 0)
    For i = 4 To UBound(Arr)
        For j = 7 To 8
            If IsNumeric(Arr(i, j)) Then Brr(i, 0) = Brr(i, 0) + Arr(i, j)
        Next
    Next
    Range("i4:i" & UBound(Brr)).Value = Brr
End Sub

liulang0808

Sub 合同动态结算金额求和()
    Worksheets("合同明细").Range("i4:i800").ClearContents '清除前一次的数据，否则会累加出错
    arr = [a1].CurrentRegion
    For i = 4 To UBound(arr)
        S = 0
        For j = 7 To 8
            If IsNumeric(arr(i, j)) Then S = S + arr(i, j)
        Next
        arr(i, 9) = S
    Next
    Application.Calculation = xlManual
    [i1].Resize(UBound(arr)) = WorksheetFunction.Index(arr, 0, 9)
    Application.Calculation = xlAutomatic
End Sub
看看是否可行

liulang0808

附件内容供参考。。。。。。

dengcaimao

liulang0808 发表于 2021-9-25 20:34
Sub 合同动态结算金额求和()
    Worksheets("合同明细").Range("i4:i800").ClearContents '清除前一次的 ...

老师，抱歉，未及时回复您。
我早上测试了，当H列全部有数值时，没问题的，但是当H列存在空值或单元格无内容时，会报错

山菊花

dengcaimao 发表于 2021-9-26 08:47
老师，抱歉，未及时回复您。
我早上测试了，当H列全部有数值时，没问题的，但是当H列存在空值或单元格无 ...

问题出在这一句：
   Arr = [a1].CurrentRegion.Value

因为A1单元格所在区域只有一行，不包括下面数据。
A1改为A3可通过：
   Arr = [a3].CurrentRegion.Value

dengcaimao

山菊花 发表于 2021-9-26 08:55
问题出在这一句：
   Arr = [a1].CurrentRegion.Value

谢谢老师，明白了，A1单元格周边出现了空行和空列，区域分开了，没注意到这个问题。
再次感谢老师！

liulang0808

dengcaimao 发表于 2021-9-26 08:50
老师，抱歉，未及时回复您。
我早上测试了，当H列全部有数值时，没问题的，但是当H列存在空值或单元格无 ...

Sub 合同动态结算金额求和()
    Worksheets("合同明细").Range("i4:i800").ClearContents '清除前一次的数据，否则会累加出错
    r = Cells(Rows.Count, 1).End(3).Row
    arr = [a1].CurrentRegion
    arr = [a1].Resize(r, 12)
    For i = 4 To UBound(arr)
        S = 0
        For j = 7 To 8
            If IsNumeric(arr(i, j)) Then S = S + arr(i, j)
        Next
        arr(i, 9) = S
    Next
    Application.Calculation = xlManual
    [i1].Resize(UBound(arr)) = WorksheetFunction.Index(arr, 0, 9)
    Application.Calculation = xlAutomatic
End Sub

楼主注意下表格区域的引用

dengcaimao

liulang0808 发表于 2021-9-26 11:50
Sub 合同动态结算金额求和()
    Worksheets("合同明细").Range("i4:i800").ClearContents '清除前一次 ...

非常感谢老师。