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线然后对其下面的组进行求和的宏 - 而无需捕获下一组。换句话说，我需要猫预算线来仅计算猫预算。

因此，宏需要使用＆＃34; GROUP *＆＃34;来识别该行，然后向下搜索，直到找到下一个＆＃34; GROUP *＆＃34;，并将两者之间的空间相加猫和狗 - 最好是作为一种功能 - 在＆＃34; GROUP - Cats＆＃34;线。

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

编辑：最终产品将是Budget列中的公式，它只是= 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

通过使用分配给这些宏的两个按钮，可以随意对数据进行总计和清除：

Apply SubTotals

Remove SubTotals

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

最后，冒着超越简报但可能进一步思考的风险 - 将“FY 13”和“FY 14”标识符分离到单独的“FY”列可能也是一个好主意。然后，您可以更灵活地对数据进行进一步分析。

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

1 个答案: