VBA Excel - 将小计公式插入特定行

Question

我的问题是here 和here 的混合，但两者都不是。我有一个奇怪的数据集，其结构更像是层次结构，而不是纯数据点系列。像这样的：

项目预算销售
组 - 猫 0 120
FY 13 波斯语 0 0
13 财年缅因浣熊 12 0
14 财年缅因猫 50 0
12 财年虎斑猫 1 0
13 财年虎斑猫 1 0
14 财年虎斑猫 2 0
FY 14 胡同 12 0
组 - 狗 0 201
14 财年牧羊犬 20 0
FY 14 实验室 31 0
FY 13 金毛猎犬 12 0
FY 12 金毛猎犬 0 0
组 - 金鱼 0 50
FY 14 金鱼 100 0
FY 13 小丑鱼 20 0
坦克费用 150 0

我需要一个宏，它可以整齐地识别 GROUP 行，然后对它下面的组求和——而不捕获下一个组。换句话说，我需要 cat 预算线来仅汇总 cat 预算。

因此，宏需要用“GROUP*”标识行，然后向下搜索直到找到下一个“GROUP*”，然后将 Cats 和 Dogs 之间的空间相加 - 最好作为一个函数 - on “GROUP - Cats”行。

我知道这是可能的，但我担心这对于我的 VBA 基本能力来说太复杂了。

编辑：最终产品将是预算列中的一个公式，即 =SUM(B3:B9)。然后 B10（Dogs GROUP）将有一个公式，例如 =SUM(B11:B14)。金鱼：=SUM(B16:18)。

但由于我的每个数据集总是在变化（例如，本周 Cats 部分可能有 20 行，而不是前一周的 18 行），我需要一个可以找到 GROUP 行之间的空间的宏。

编辑 2： 我当前使用的 VBA 的功能与我正在寻找的类似 - 它基本上根据销售列中出现的数字对我的部分进行分组和折叠：

Dim rStart As Range, r As Range
Dim lLastRow As Long, sColumn As String
Dim rColumn As Range
'### The Kittens everywhere! thing is just to make sure the last group has an end point
Range("C1").End(xlDown).Offset(1).Value = "Kittens everywhere!"
    sColumn = "C"

With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight

lLastRow = Cells(Rows.Count, sColumn).End(xlUp).Row
With ActiveSheet
    Set rColumn = .Range(.Cells(1, sColumn), Cells(lLastRow, sColumn))
    With rColumn
        Set r = .Cells(1, 1)
        Do Until r.Row > lLastRow
            If rStart Is Nothing Then
                If r.Value = "0" Then
                    Set rStart = r
                End If
            Else
                If r.Value <> "0" Then
                    Range(rStart, r.Offset(-1, 0)).Rows.Group
                    Set rStart = Nothing
                End If
            End If
            Set r = r.Offset(1, 0)
        Loop
    End With
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1
End With

Range("C:C").Find("Kittens everywhere!").ClearContents

宏还有更多功能——因为它还可以做一些事情，比如突出显示 GROUP 行——但我确定我是否可以将这个 SUM 函数的东西塞进那个部分。

Answer 1

这是一个可能合适也可能不合适的建议，但它确实为您提供了一个选择。它使用内置的 Excel SubTotal 函数。有一些优点和缺点（见下文）。

它需要两个 Subs，一个应用 SubTotals：

Sub STPets()
Dim ws As Worksheet
Dim strow As Long, endrow As Long, stcol As Long, endcol As Long
Dim drng As Range

strow = 3
stcol = 3  'Col C
endcol = 6  'Col F

Set ws = Sheets("Sheet1")

    With ws
        'find last data row
        endrow = Cells(Rows.Count, stcol).End(xlUp).Row

        'sort data
        Set drng = .Range(.Cells(strow, stcol), .Cells(endrow, endcol))
        drng.Sort Key1:=.Cells(strow + 1, stcol), Order1:=xlAscending, Header:=xlYes

        'apply Excel SubTotal function
        .Cells.RemoveSubtotal
        drng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3)

    End With

End Sub 

还有一个要清除，例如添加更多数据：

Sub RemoveSTPets()
Dim ws As Worksheet

Set ws = Sheets("Sheet1")
ws.Cells.RemoveSubtotal

End Sub

使用分配给这些宏的两个按钮可以随意汇总和清除数据：

正如您所见，它需要对您的数据进行轻微的重新排列，但可以说这使得它更加灵活且与数据库格式保持一致（展望未来？）。在列表中的任何位置添加新数据也可以说更容易，并且更容易添加/更改组（代码），即清除 > 添加更多数据 > 重新总计。您可以根据 Excel SubTotal 功能进一步自定义。

最后，冒着超出简要说明的风险，但可能需要进一步深思 - 将“FY 13”和“FY 14”标识符分离到单独的“FY”列中也可能是个好主意。随着时间的推移，您可能会发现对您的数据进行进一步分析会更加灵活。