VBA代码为小计添加了不正确的列行

Question

我正在尝试更新以前的员工代码。 D和E列未添加正确的小计。似乎对于每个子总计行，它都在计数A4，这是第一行数字。

不确定如何调整代码。

Set firstSub = Range("D" & cTL.Row) 'set first sum from

For Each c In Range("D" & cTL.Row, "D" & cBR.Row)
    If c.Value2 = "" Then
        c.ClearContents
    End If
    'This if will only run for column D, but will fill column D and E with total fields
    If Right(c.Offset(0, -2).Value2, Len(sTotal)) = sTotal Then
        c.FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Column & ")"
        c.Offset(0, 1).FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Offset(0, 1).Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Offset(0, 1).Column & ")"
        formulaStrD = formulaStrD & c.Address([], [], xlR1C1) & ","
        formulaStrE = formulaStrD & c.Offset(0, 1).Address([], [], xlR1C1) & ","
    ElseIf Right(Range("A" & c.Row), Len(sTotal)) = sTotal Then
        formulaStrD = Left(formulaStrD, Len(formulaStrD) - 1)
        formulaStrE = Left(formulaStrE, Len(formulaStrE) - 1)
        c.FormulaR1C1 = "=SUM(" & formulaStrD & ")"
        c.Offset(0, 1).FormulaR1C1 = "=SUM(" & formulaStrE & ")"
    End If
Next c

For Each c In Range("E" & cTL.Row, "H" & cBR.Row)
    If c.Value2 = "" Then
        c.ClearContents
    End If
Next c

End Function

Answer 1

解决此问题的关键（我认为）是每当B列中的值发生更改时“重置”“第一行”-否则，B列中每个不同值的每个小计将反映所有其上方的行-包括其他小计。

Set firstSub = Range("D" & cTL.Row) 'set first sum from

For Each c In Range("D" & cTL.Row, "D" & cBR.Row)
    If c.Value2 = "" Then
        c.ClearContents
    End If
    'This if will only run for column D, but will fill column D and E with total fields
    If Right(c.Offset(0, -2).Value2, Len(sTotal)) = sTotal Then
        c.FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Column & ")"
        c.Offset(0, 1).FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Offset(0, 1).Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Offset(0, 1).Column & ")"
        formulaStrD = formulaStrD & c.Address([], [], xlR1C1) & ","
        ' Fix the Column E subtotal reference
        formulaStrE = formulaStrE & c.Offset(0, 1).Address([], [], xlR1C1) & ","

        ' Reset the "firstRow" so that we don't accidentally pickup
        ' the other subtotals
        Set firstSub = c.Offset(1, 0)

    ElseIf Right(Range("A" & c.Row), Len(sTotal)) = sTotal Then
        formulaStrD = Left(formulaStrD, Len(formulaStrD) - 1)
        formulaStrE = Left(formulaStrE, Len(formulaStrE) - 1)
        c.FormulaR1C1 = "=SUM(" & formulaStrD & ")"
        c.Offset(0, 1).FormulaR1C1 = "=SUM(" & formulaStrE & ")"

        ' Reset the subtotal formulas along with the "firstRow"
        formulaStrD = ""
        formulaStrD = ""
        Set firstSub = c.Offset(1, 0)

    End If
Next c

For Each c In Range("E" & cTL.Row, "H" & cBR.Row)
    If c.Value2 = "" Then
        c.ClearContents
    End If
Next c