如何调整数据透视表筛选器

时间:2018-08-20 14:52:13

标签: excel vba excel-vba pivot-table

我正在尝试创建一个宏,该宏将从数据透视表中提取一些数据到集合变量中。我想要做的是在一年中每月收集每篇文章的销售预测和见解(下图)。我遇到的问题是,我不知道如何在不将数据显示在数据透视表中的情况下收集信息,而且我也不知道如何让宏调整列过滤器以满足我的要求。

enter image description here

我无权访问此数据透视表的源,并且我不愿意让用户手动调整表的列过滤器。

为清楚起见,列过滤器按年份->季度->月->周进行。

编辑:

我要完成的工作从计划工作簿开始,其中保留了相关的文章编号。 Master Scheduler的工作簿与输入值(上面的数据透视表)不同,可以作为计算的基础。此输入工作簿仅具有数据透视表,但我不知道它将数据从何处拉出。正是这是Master Scheduler手动查找相关数据的地方。

我的思想过程是从计划工作簿中提取相关文章,将所有文章拉出一整年,仅对相关文章进行分类,然后将排序后的信息放入“计划”工作簿中的新位置。

我遇到的问题是列过滤器可能不会显示所有相关数据,而且我不知道如何使VBA设置数据透视表的过滤器来防止这种情况。我找到的解决方案将F9单元格“ Year”更改为实际的年值,这不是我想要的。

此外,当您手动打开列过滤器以选择哪一年时,在四个季度(或季节)中,所有四个月中的所有四个月都必须在复选框中打勾,以使所有十二个月可用。

希望这可以澄清我的问题。

1 个答案:

答案 0 :(得分:0)

经过更多研究,我发现此网站回答了我的问题:Expand and Collapse Entire Pivot Table Fields – VBA Macro。我还了解了pt.ClearAllFilters命令。

如果以后无法访问该网站,则代码也会在下面列出。

展开:

Sub Expand_Entire_RowField()
    'Expand the lowest position field in the Rows area
    'that is currently expanded (showing details)

    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim iFieldCount As Long
    Dim iPosition As Long

      'Create reference to 1st pivot table on sheet
      'Can be changed to reference a specific sheet or pivot table.
      Set pt = ActiveSheet.PivotTables(1)

      'Count fields in Rows area minus 1 (last field can't be expanded)
      iFieldCount = pt.RowFields.Count - 1

      'Loop by position of field
      For iPosition = 1 To iFieldCount
        'Loop fields in Rows area
        For Each pf In pt.RowFields
          'If position matches first loop variable then
          If pf.Position = iPosition Then
            'Loop each pivot item
            For Each pi In pf.PivotItems
              'If pivot item is collapsed then
              If pi.ShowDetail = False Then
                'Expand entire field
                pf.ShowDetail = True
                'Exit the macro
                Exit Sub
              End If
            Next pi
          End If
        Next pf
      'If the Exit Sub line is not hit then the
      'loop will continue to the next field position
      Next iPosition

    End Sub

崩溃:

Sub Collapse_Entire_RowField()
'Collapse the lowest position field in the Rows area
'that is currently expanded (showing details)

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim iFieldCount As Long
Dim iPosition As Long

  'Create reference to 1st pivot table on sheet
  'Can be changed to reference a specific sheet or pivot table.
  Set pt = ActiveSheet.PivotTables(1)

  'Count fields in Rows area minus 1 (last field can't be expanded)
  iFieldCount = pt.RowFields.Count - 1

  'Loop backwards by position of field (step -1)
  For iPosition = iFieldCount To 1 Step -1
    'Loop fields in Rows area
    For Each pf In pt.RowFields
      'If position matches first loop variable then
      If pf.Position = iPosition Then
        'Loop each pivot item
        For Each pi In pf.PivotItems
          'If pivot item is expanded then
          If pi.ShowDetail = True Then
            'Collapse entire field
            pf.ShowDetail = False
            'Exit the macro
            Exit Sub
          End If
        Next pi
      End If
    Next pf
  'If the Exit Sub line is not hit then the
  'loop will continue to the next field position
  Next iPosition

End Sub

修改:特定于解决方案

Dim pt As PivotTable
Dim pf As PivotField

Set pt = ws.PivotTables(1) 

'Setting all of the column filters to desired setup
For Each pf In pt.ColumnFields
    pf.Hidden = False
    pf.ClearAllFilters

    'Drill Down until Months are opened, then exit the loop
    If UBound(Split(pf.Name, "Month")) > 0 Then
        pf.DrilledDown = False  '<-- Ensuring nothing beneath "Months" is 
        Exit For
    Else
        pf.DrilledDown = True
    End If
Next