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

Question

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

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

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

编辑：

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

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

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

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

希望这能澄清我的问题。

Answer 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