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」列。隨後您可能會發現它可以更靈活地隨着時間對數據進行進一步分析。