Excel VBA - 数据透视表中计算项的动态设置

时间:2017-03-02 14:53:32

标签: excel vba excel-vba

我有一个使用计算项目的数据透视表。我对计算项目的输入动态变化。我一直要求用户使用InputBox方法输入公式。但现在,我想把它设置为动态,但我无法让它们发挥作用。这是我的数据,

   Category Checks
    18-20   Yes
    18-20   Yes
    16-18   Yes
    16-18   Yes
    20-24   Yes
    24-30   Yes
    30-35   Yes
    35-40   Yes
    14-16   Yes

这是我正在寻找的Pivot表输出,

    Column Labels       
                Less than 20    More than 20    Grand Total
Count of Checks 5              4                9

小于20且超过20个是计算项目。最初我正在硬编码这样的公式 -

ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").CalculatedItems. _
        Add "Less than 20", "='16-18' +'18-20'", True
ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").CalculatedItems. _
        Add "More than 20", "='20-24' +'24-30' +'30-35' +'35-40'", True

当存在所有这些类别(' 16-18',#18; 18-20'等)时,没有问题。但它并没有出现在某些表格中。

然后我通过设置字符串变量要求用户输入公式。但现在,我希望它更具动态性并且公式自动发生。请帮助我。我试了很多FOR 2天,但我无法理解逻辑。

我现在能够在列类别中获取唯一值。现在,我如何在公式

中设置它
colmz = WorksheetFunction.Match("Category", Sheets(Ssheet1").Rows(1), 0)
Nrowz = ActiveSheet.Cells(Rows.Count, colmz).End(xlUp).Row
B = GetColumnName(colmz)

    For i = 2 To Nrowz
        CellVal = Sheets("Sheet1").Range(B & i).Value
        On Error Resume Next
        Col.Add CellVal, Chr(34) & CellVal & Chr(34)
        On Error GoTo 0
    Next i

    For Each itm In Col
        Debug.Print itm
    Next

2 个答案:

答案 0 :(得分:0)

一个好的选择是在数据透视表中使用组功能。您只需选择要分组的列 - >右键单击 - >从上下文菜单中选择“组”。

enter image description here

然后,枢轴将为您进行分组,如下所示。

enter image description here

然后,您的用户可以选择单击+按钮向下钻取并查看未编辑的项目(如果需要)。

enter image description here

答案 1 :(得分:0)

假设您在活动工作表中有一个名为“PivotTable5”的数据透视表,在名为“类别”的字段中可能有也可能没有列表中的项目,您可以为计算项目使用一些动态字符串变量。这是我拼凑起来的一些快速 VBA,可以解决这个特定问题。

Sub Macro1()
    'DECLARE VARIABLES
        Dim STRING_ITEMS As String
        Dim STRING_LESS_THAN20 As String
        Dim STRING_MORE_THAN20 As String
    
        Dim PT_ITEM As PivotItem
    
    'LOOP THROUGH PIVOT ITEMS TO BUILD A HELPER STRING OF ALL ITEMS THAT END UP SHOWING UP IN THE PIVOT TABLE.
        STRING_ITEMS = ""
        For Each PT_ITEM In ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").PivotItems
            Select Case PT_ITEM.Name
                'MAKE SURE TO MAKE A CASE BUCKET FOR ALL UNIQUE POSSIBLE CATEGORIES
                    Case Is = "14-16"
                        STRING_ITEMS = STRING_ITEMS & ", '14-16'"
                    Case Is = "16-18"
                        STRING_ITEMS = STRING_ITEMS & ", '16-18'"
                    Case Is = "18-20"
                        STRING_ITEMS = STRING_ITEMS & ", '18-20'"
                    Case Is = "20-24"
                        STRING_ITEMS = STRING_ITEMS & ", '20-24'"
                    Case Is = "24-30"
                        STRING_ITEMS = STRING_ITEMS & ", '24-30'"
                    Case Is = "30-35"
                        STRING_ITEMS = STRING_ITEMS & ", '30-35'"
                    Case Is = "35-40"
                        STRING_ITEMS = STRING_ITEMS & ", '35-40'"
            End Select
        Next PT_ITEM
    'REMOVE THE "," AT THE FRONT OF THE STRING
        If Left(STRING_ITEMS, 1) = "," Then
            STRING_ITEMS = Right(STRING_ITEMS, Len(STRING_ITEMS) - 1)
        End If
    'WE'RE LEFT WITH A DYNAMIC STRING INCLUDING ONLY THE ITEMS THAT SHOW UP IN THE PIVOT TABLE IN THIS FORMAT:  '14-16','20-24','30-35'
    
    
    'NOW BUILD THE NEXT HELPER STRING - LESS THAN 20
        STRING_LESS_THAN20 = ""
        If InStr(1, STRING_ITEMS, "'14-16'") > 0 Then
            STRING_LESS_THAN20 = STRING_LESS_THAN20 & ", '14-16'"
        End If
        If InStr(1, STRING_ITEMS, "'16-18'") > 0 Then
            STRING_LESS_THAN20 = STRING_LESS_THAN20 & ", '16-18'"
        End If
        If InStr(1, STRING_ITEMS, "'18-20'") > 0 Then
            STRING_LESS_THAN20 = STRING_LESS_THAN20 & ", '18-20'"
        End If
    'REMOVE "," IN FRONT
        If Left(STRING_LESS_THAN20, 1) = "," Then
            STRING_LESS_THAN20 = Right(STRING_LESS_THAN20, Len(STRING_LESS_THAN20) - 1)
        End If
        
        
    'NOW BUILD THE NEXT HELPER STRING - MORE THAN 20
        STRING_MORE_THAN20 = ""
        If InStr(1, STRING_ITEMS, "'20-24'") > 0 Then
            STRING_MORE_THAN20 = STRING_MORE_THAN20 & ", '20-24'"
        End If
        If InStr(1, STRING_ITEMS, "'24-30'") > 0 Then
            STRING_MORE_THAN20 = STRING_MORE_THAN20 & ", '24-30'"
        End If
        If InStr(1, STRING_ITEMS, "'30-35'") > 0 Then
            STRING_MORE_THAN20 = STRING_MORE_THAN20 & ", '30-35'"
        End If
        If InStr(1, STRING_ITEMS, "'35-40'") > 0 Then
            STRING_MORE_THAN20 = STRING_MORE_THAN20 & ", '35-40'"
        End If
    'REMOVE "," IN FRONT
        If Left(STRING_MORE_THAN20, 1) = "," Then
            STRING_MORE_THAN20 = Right(STRING_MORE_THAN20, Len(STRING_MORE_THAN20) - 1)
        End If
        
        
    'YOU NOW HAVE 3 CLEAN STRINGS THAT ARE SET UP FOR A NICE "SUM" CALCULATED ITEM
        ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").CalculatedItems.Add "LESS THAN 20", _
        "=SUM(" & STRING_LESS_THAN20 & ")", True
        
        ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").CalculatedItems.Add "MORE THAN 20", _
        "=SUM(" & STRING_MORE_THAN20 & ")", True
        
    'IF YOU ONLY WANT THESE 2 CALCULATED ITEMS TO DISPLAY, YOU CAN HIDE THE OTHER ITEMS
        For Each PT_ITEM In ActiveSheet.PivotTables("PivotTable5").PivotFields("Category").PivotItems
            Select Case PT_ITEM.Name
                Case Is = "LESS THAN 20"
                Case Is = "MORE THAN 20"
                Case Else
                    PT_ITEM.Visible = False
            End Select
        Next PT_ITEM
End Sub