Макрос для добавления формул, где несколько строк выше

Question

Я делал финансовые отчеты компании, я выполнял большую часть работы вручную (сортировка по продукту, компании и т. Д.). Проблема в том, что я использовал приведенный ниже макрос для добавления в две строки, поэтому я могу рассчитывать расходы на клиента.

Теперь я хочу добавить эти разрывы, но в первой пустой строке я хочу скопировать и вставить значения из ячеек выше для столбцов A, B и C. В столбцах D и E я хотел бы суммировать смежные ячейки выше, в то время как столбец F должен вычислять разницу между вычисленными значениями в D & E (так =D-E), а в столбце G следует отработать % (=(Fx/Dx)*100). Если есть способ сделать это только в том случае, если над всем есть несколько строк, то лучше.

Код, который я использовал до сих пор, приведен ниже и дает мне разрывы строк, которые я использовал. Но с моим RSI копирование необходимых ячеек и выполнение всех формул вручную не помогает.

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("b1")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert Shift:=x1Down
    Cells(iRow + 1, iCol).EntireRow.Insert Shift:=x1Down
    iRow = iRow + 3
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub

Пример данных

К чему я стремлюсь

Я полный новичок в этом, поэтому любая помощь будет оценена.

Answer 1

Другой способ с VBA:

Option Explicit

Sub test()

    Dim i As Long, LastRow As Long, StartRow As Long, EndRow As Long
    Dim CurrentAccount As String, PreviousAccount As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        StartRow = LastRow + 1

        For i = LastRow To 2 Step -1

            CurrentAccount = .Range("B" & StartRow).Value
            PreviousAccount = .Range("B" & i).Value

            If CurrentAccount <> PreviousAccount Then

                EndRow = i

                .Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                StartRow = i

            End If

        Next i

        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        StartRow = 0
        EndRow = 0

        For i = 2 To LastRow

            If .Range("B" & i).Value <> "" And StartRow = 0 And EndRow = 0 Then
                StartRow = i
            ElseIf .Range("B" & i).Value = "" And StartRow <> 0 And EndRow = 0 Then
                EndRow = i - 1
            End If

            If StartRow <> 0 And EndRow <> 0 Then

                .Range("D" & i).Formula = "=SUM(D" & StartRow & ":D" & EndRow & ")"
                .Range("E" & i).Formula = "=SUM(E" & StartRow & ":E" & EndRow & ")"
                .Range("F" & i).Formula = "=D" & EndRow & "-" & "E" & EndRow
                .Range("G" & i).Formula = "=(E" & EndRow & "/" & "D" & EndRow & ")" & "*" & 100

                StartRow = 0
                EndRow = 0

            End If

        Next i

    End With

End Sub

Answer 2

Альтернативное решение, которое вы можете рассмотреть, - это сохранить данные в их первоначальном формате и добавить итоговую строку. Если данные представляют собой таблицу, вы можете сделать это, выбрав Total Row на вкладке Design ; в противном случае вы можете использовать формулу SUBTOTAL() и автоматическую фильтрацию для достижения того же результата. Я использовал таблицы для моего примера.

Без фильтрации вы получите результаты для всего набора данных:

При фильтрации по определенному значению Account или Customer вместо этого суммируются значения только для этих строк: