在 Excel VBA 中对以上所有内容求和，直到下一个空白单元格为止，求和到空白单元格中

Question

我有这个电子表格，我需要在其中总结工作时间。在列 'I' 中，我得到了所有工作时间，我在行 'E' 中通过周数排序，并使用我在 Google 某处找到的以下循环（不记得是谁写的，但它有效).

Dim i, itotalrows As Integer
Dim strRange As String

itotalrows = ActiveSheet.Range("E20000").End(xlUp).Offset(1, 0).Row


Do While i <= itotalrows
    i = i + 1
    strRange = "E" & i
    strRange2 = "E" & i + 1
    If Range(strRange).Text <> Range(strRange2).Text Then
        Rows(i + 1).Insert
        itotalrows = ActiveSheet.Range("E20000").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If

Loop

在图片中，您可以看到其中一个单元格标有“单元格总值向上 “ 每隔几行就有一个空白，在 'I' 上有一个单元格应该放在总值的位置。

Sheet 图片：

Answer 1

如果您用以下代码替换您的代码，我相信它应该能达到您的预期：

Sub foo()
Dim i, itotalrows As Integer
Dim strRange As String

itotalrows = ActiveSheet.Range("E20000").End(xlUp).Offset(1, 0).Row

Do While i <= itotalrows
    i = i + 1
    strRange = "E" & i
    strRange2 = "E" & i + 1
    If Range(strRange).Text <> Range(strRange2).Text Then
        Rows(i + 1).Insert
        Cells(i + 1, "I").FormulaR1C1 = "=SUMIF(C[-4],R[-1]C[-4],C)"
        'when inserting a new row, simply add this formula to add up the values on column I
        itotalrows = ActiveSheet.Range("E20000").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If
Loop
End Sub

鉴于您的代码已经完成了您想要的操作（即，当 E 列的值不同时添加新行），然后将公式添加到该行将添加 I 列上的所有内容，其中 E 列的值为一样。

Answer 2

这是对空白单元格中的单元格求和的通用方法。如果这是输入那么正确的图片应该是输出：

.

使用此代码：

Sub TestMe()    
    Dim myCell      As Range
    Dim currentSum  As Double        
    For Each myCell In Worksheets(1).Range("A1:A14")
        If myCell = vbNullString Then
            myCell = currentSum
            myCell.Interior.Color = vbRed
            currentSum = 0
        Else
            currentSum = currentSum + myCell
        End If
    Next myCell           
End Sub

这个想法只是为currentSum 使用一个变量，并在每次单元格为空时写入它。如果不为空，则用单元格值

递增

Answer 3

也许根据 G 列中空白的位置对 I 列中的组求和

Sub x()

Dim r As Range

For Each r In Range("G:G").SpecialCells(xlCellTypeConstants).Areas
    r.Cells(r.Count + 1).Offset(, 2).Value = WorksheetFunction.Sum(r.Offset(, 2))
Next r

End Sub

在 Excel VBA 中对以上所有内容求和，直到下一个空白单元格为止，求和到空白单元格中

Sum into blank cell while summing all above until next blank cell, in Excel VBA

excel

vba

spreadsheet

excel-formula