宏以添加公式，其中上方是多行

Question

我一直在做公司的财务摘要，我一直在做很多手工工作（按产品，公司等进行分类）。问题是我一直在使用下面的宏在两行中添加，因此我可以计算出每个客户的支出。

现在我想做的是在这些中断处添加内容，但是在第一行空白行中，我想复制并粘贴以上A，B和{{ 1}}。在D列和C中，我想对上面的连续单元格求和，而F列应计算出E和D中的计算值之差（所以E ），而列=D-E应该算出G。如果只有一种方法可以做到这一点，那么最好是多于一行。

我到目前为止一直在使用的代码在下面，这给了我一直在使用的换行符。但是对于我的RSI，复制必需的单元格并手动执行所有公式并没有帮助。

% (=(Fx/Dx)*100)

示例数据

我的目标是

我是这方面的新手，所以我们将不胜感激。

Answer 1

您可能要考虑的另一种解决方案是将数据保留其原始格式并添加总行。如果数据是表格，则可以通过从 Design 标签中选择 Total Row 来完成；否则，您可以使用SUBTOTAL()公式和自动过滤来获得相同的结果。我以表格为例。

不进行过滤，您将获得整个数据集的结果：

当您根据Account或Customer的特定值进行过滤时，它只会汇总这些行的值：

Answer 2

使用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