我正在尝试创建一个宏,该宏将从数据透视表中提取一些数据到集合变量中。我想要做的是在一年中每月收集每篇文章的销售预测和见解(下图)。我遇到的问题是,我不知道如何在不将数据显示在数据透视表中的情况下收集信息,而且我也不知道如何让宏调整列过滤器以满足我的要求。
我无权访问此数据透视表的源,并且我不愿意让用户手动调整表的列过滤器。
为清楚起见,列过滤器按年份->季度->月->周进行。
编辑:
我要完成的工作从计划工作簿开始,其中保留了相关的文章编号。 Master Scheduler的工作簿与输入值(上面的数据透视表)不同,可以作为计算的基础。此输入工作簿仅具有数据透视表,但我不知道它将数据从何处拉出。正是这是Master Scheduler手动查找相关数据的地方。
我的思想过程是从计划工作簿中提取相关文章,将所有文章拉出一整年,仅对相关文章进行分类,然后将排序后的信息放入“计划”工作簿中的新位置。
我遇到的问题是列过滤器可能不会显示所有相关数据,而且我不知道如何使VBA设置数据透视表的过滤器来防止这种情况。我找到的解决方案将F9单元格“ Year”更改为实际的年值,这不是我想要的。
此外,当您手动打开列过滤器以选择哪一年时,在四个季度(或季节)中,所有四个月中的所有四个月都必须在复选框中打勾,以使所有十二个月可用。
希望这可以澄清我的问题。
答案 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