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

Question

我的问题是发生了什么here和here的混合，但它们都不是很好。我有一个奇怪的数据集，它的结构更像一个层次结构，而不是一系列纯粹的数据点。事情是这样的：

Item       Budget  Sales 
GROUP - Cats      0   120 
FY 13 Persian      0   0 
FY 13 Maine Coon     12   0 
FY 14 Maine Coon     50   0 
FY 12 Tabby      1   0 
FY 13 Tabby      1   0 
FY 14 Tabby      2   0 
FY 14 Alley      12   0 
GROUP - Dogs      0   201 
FY 14 Collie      20   0 
FY 14 Lab      31   0 
FY 13 Golden Retriever   12   0 
FY 12 Golden Retriever   0   0 
GROUP - Gold Fish     0   50 
FY 14 Goldfish     100   0 
FY 13 Clown Fish     20   0 
Tanks Fees      150   0 

我需要一个宏，可以整齐地标识该组线，然后求和组在它之下 - 没有捕捉下一组。换句话说，我需要猫预算项目来总结猫的预算。

所以宏需要识别带有“GROUP *”的行，然后向下搜索直到找到下一个“GROUP *”，然后将Cat和Dog之间的空间相加 - 最好作为函数 - 在“GROUP - Cats”行上。

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

编辑：最终产品将在预算列中简单地= SUM（B3：B9）的公式。然后B10（狗组）将有一个公式，例如= SUM（B11：B14）。对于黄金鱼：= SUM（B16：18）。

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

编辑2：我使用的是目前做类似的东西是什么我正在寻找的VBA - 它本质团体和折叠基础上的数字我的部分出现在Sales列：

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功能。有一些优点和缺点（见下文）。

它需要两个替补，一个适用的小计：

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小计的功能进一步进行自定义。

最后，冒着越过短暂的风险，但也许有更多的想法 - 也许是一个好主意，将您的“13年”和“14年”标识符分离为单独的“FY”列。随后您可能会发现它可以更灵活地随着时间对数据进行进一步分析。