Код 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