VBA Excel - 将小计公式插入特定行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27068103/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Excel - Inserting Subtotal Formulas into Specific Rows
提问by PersonalSpace
My issue is kind of a blend of what's happening hereand here, but is very much neither. I've got a weird dataset that is structured more like a hierarchy than a pure series of data points. Something like this:
我的问题是这里和这里发生的事情的混合，但两者都不是。我有一个奇怪的数据集，它的结构更像是一个层次结构，而不是一系列纯数据点。像这样的东西：
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
I need a macro that can neatly identify the GROUP lines and then sum the group underneath it -- without capture the next group. In other words, I need the cat budget line to sum only the cat budgets.
我需要一个宏，它可以整齐地识别 GROUP 行，然后对它下面的组求和 - 无需捕获下一组。换句话说，我需要猫预算线来仅对猫预算求和。
So the macro would need to identify the line with the "GROUP*", then search down until it finds the next "GROUP*", and sum the space in between Cats and Dogs -- preferably as a function -- on the "GROUP - Cats" line.
因此，宏需要用“GROUP*”标识该行，然后向下搜索直到找到下一个“GROUP*”，并对“GROUP”上的 Cats 和 Dogs 之间的空间求和（最好作为函数） - 猫”行。
I know this has to be possible, but I'm worried it's too complicated for my basic abilities in VBA.
我知道这必须是可能的，但我担心这对于我在 VBA 中的基本能力来说太复杂了。
EDIT:The end product would be a formula in the Budget column that is simply =SUM(B3:B9). Then B10 (the Dogs GROUP) would have a formula such as =SUM(B11:B14). For Gold Fish: =SUM(B16:18).
编辑：最终产品将是预算列中的公式，即 =SUM(B3:B9)。然后 B10（狗组）将有一个公式，例如 =SUM(B11:B14)。对于金鱼：=SUM(B16:18)。
But since each my dataset is always changing (for instance, this week there may be 20 lines in the Cats section instead of 18 the previous week), I need a macro that can find the space between the GROUP lines.
但是由于我的每个数据集总是在变化（例如，本周 Cats 部分可能有 20 行，而不是前一周的 18 行），我需要一个宏来找到 GROUP 行之间的空间。
EDIT 2:The VBA I'm using currently does something similar to what I'm looking for -- it essentially groups and collapses my sections based on the numbers that appear in the Sales column:
编辑 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
There's more to the macro -- because it's also doing some things like highlighting the GROUP rows -- but I'm sure if I can jam this SUM function stuff into that section or not.
宏还有更多功能——因为它还在做一些事情，比如突出显示 GROUP 行——但我确定我是否可以将这个 SUM 函数的东西塞进那个部分。
回答by barryleajo
This is a suggestion that may or may not be appropriate but it does offer an option for you. It uses the built in Excel SubTotal function. There are some pros and cons (see below).
这是一个可能合适也可能不合适的建议，但它确实为您提供了一个选择。它使用内置的 Excel SubTotal 函数。有一些优点和缺点（见下文）。
It requires two Subs, one to apply SubTotals:
它需要两个 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
and one to Clear e.g. to add more data:
和一个清除例如添加更多数据：
Sub RemoveSTPets()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Cells.RemoveSubtotal
End Sub
The data can be totalled and cleared at will, by using two buttons assigned to these macros:
通过使用分配给这些宏的两个按钮，可以随意汇总和清除数据：
As you can see it requires a slight re-arrangement of your data but arguably this makes it more flexible and consistent with database format (looking to the future?). It is also arguably easier to add new data anywhere in the list and easier to add/change groups (Codes) i.e. Clear > Add more data > re-Total. You can customise further in accordance with the Excel SubTotal functionality.
正如您所看到的，它需要对数据进行轻微的重新排列，但可以说这使其更加灵活并与数据库格式保持一致（展望未来？）。在列表中的任何位置添加新数据也更容易，并且更容易添加/更改组（代码），即清除 > 添加更多数据 > 重新总计。您可以根据 Excel 小计功能进一步自定义。
Finally, at the risk of overstepping the brief, but further food for thought perhaps - it might also be a good idea to separate-out your 'FY 13' and 'FY 14' identifiers into a separate "FY" column. You may then find it more flexible to do further analysis on your data over time.
最后，冒着超出简要说明的风险，但可能需要进一步思考 - 将“FY 13”和“FY 14”标识符分离到单独的“FY”列中也可能是一个好主意。然后，您可能会发现随着时间的推移对数据进行进一步分析会更加灵活。
