如何调整数据透视表过滤器

Posted 2023-03-29

【中文标题】如何调整数据透视表过滤器

【英文标题】：How to adjust PivotTable Filters

【发布时间】：2018-08-20 14:52:13

【问题描述】：

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

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

为了澄清，列过滤器按年 -> 季度 -> 月 -> 周。

编辑：

我要完成的工作始于保存相关文章编号的日程安排工作簿。 Master Scheduler 有一个不同的工作簿，其中包含输入值（上面的数据透视表）作为计算的基础。这个输入工作簿只有数据透视表，我不知道它在哪里提取数据；这就是 Master Scheduler 手动查找相关数据的地方。

我的思路是从排程工作簿中拉出相关文章，将整整一年的所有文章拉出来，只整理出相关文章，将整理好的信息放到排程工作簿中的新位置。

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

此外，当您手动打开列过滤器以选择哪一年时，有四个季度（或季节），所有四个季度（或季节）都必须在方框中打上复选标记，所有十二个月都可用。

希望这能澄清我的问题。

【问题讨论】：

我已经阅读了这个问题几次，但我不确定你要做什么......所以你想创建一个New Collection（为什么？？）然后用这些文章编号和他们的洞察力加载它（这些是什么？我看到两列洞察力然后你的图片被切断了，还有更多吗？？）。您需要更具体和/或使用外行术语来说明您要完成的工作。

另外，您无权访问源数据？包含源数据的工作表是否受到保护？

是的，它是受控文件。我正在将受控工作簿中的数据导入另一个工作簿，我可以在其中不受限制地使用数据。一旦收集到数据，我就可以整理相关信息。有数百篇文章可供整理。

@dwirony 这是否澄清了问题？

听起来您只需要对现有数据透视表进行不同的分组。我是用手机写的，所以“我记得”你只需要在日期字段中的任意位置单击数据透视表，然后在功能区上会有 2 个特定于数据透视表的选项卡。单击设计（？），然后单击“删除分组”，然后单击“分组”并取消选择除年份之外的每个日期部分。 （我可能有错误的步骤，但谷歌“按年分组数据透视表”以获得确切的步骤。）这一切都假设您的日期存储为有效的 Excel 日期（而不是文本）。

【参考方案1】：

经过更多研究，我发现这个网站可以回答我的问题：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