Select 来自 Table VBA 的单个切片器项目
Select single slicer item from Table VBA
我正在尝试为选定的预算持有人(从预算持有人 Table 中选择)打印报告,使用预算持有人的姓名输入切片器,然后更新各种数据透视表 tables .
问题是代码选择切片器中的所有预算持有者,而不是选择我从 table.
中选择的单个预算持有者
Sub PrintPDFsSO()
Dim Lobj As ListObject
Dim Budholder As String
Dim Path As String
Dim x As Long, y As Long, Number_of_rows As Long
Dim SourceBk As Workbook
Dim SlicItem As SlicerItem, SlicDummy As SlicerItem, SlicCache As SlicerCache
Dim pt As PivotTable, wb As Workbook, ws As Worksheet
Set SourceBk = ThisWorkbook
Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")
For x = 1 To Lobj.DataBodyRange.Rows.Count 'Budget Holders held in BudHolderList Table
Dim BudHolders()
ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count) 'as Budholders will only ever hold one budget hodler name, can this be simpified?
Dim Counter As Long
Counter = 1
If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then
Budholder = Lobj.DataBodyRange(x, 3) 'Name of budget holder held in 3rd column of Budget Holder Table
BudHolders(Counter) = Budholder 'Budholders holds the budget holder name
Counter = Counter + 1
ReDim Preserve BudHolders(1 To Counter - 1)
' Trying to stop slicers/pivot tables calculating so code setting new filter on budget name doesnt get stuck - but not working
Application.Calculation = xlCalculationManual
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = True
Next pt
Next ws
'Code to change budget holder in slicer to next budget holder in selection from Table
For y = LBound(BudHolders) To UBound(BudHolders)
With SlicCache
.ClearManualFilter 'clears all filters and shows all items in budget holder slicer
For Each SlicItem In .SlicerItems
If BudHolders(y) <> SlicItem.Value Then 'Tests if the slicer item matches the current a value of budholder
SlicItem.Selected = False 'Grinding to a virtual halt on this line as it 'calculates and populates pivot table report'
End If
Next SlicItem
End With
Next y
Application.Calculation = xlCalculationAutomatic
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = False
Next pt
Next ws
'Use budholder name which will populate some graphs etc in workbook with new figures
SourceBk.Sheets("Graphs - Summary").Range("BudHolder_SG").Value = Budholder
'Do Printing, saving etc
End If
Next
End Sub
能不能反过来把不需要的隐藏起来?以下代码基于从 table 中选取过滤器并应用于数据透视表 table。
注意:它将所有 table 个过滤器存储在一个数组中,然后循环此数组以将过滤器一次一个地应用于与枢轴关联的切片器。
您肯定希望使代码更加模块化,并将其分离为单独的函数/子过滤器的存储、数组循环和任何单独的操作,例如循环数组时生成报告
在移动设备上,缩进可能有点偏差。
Option Explicit
Sub PrintPDFs()
Dim Lobj As ListObject
Dim BudHolder As String
Dim SlicItem As SlicerItem, SlicCache As SlicerCache
Dim SourceBk As Workbook
Dim x As Long
Set SourceBk = ThisWorkbook
'Picks up Table with budget holder details
Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
'Picks up slicer which drives pivot tables in workbook
Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")
Dim BudHolders()
ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count)
Dim counter As Long
counter = 1
For x = 1 To Lobj.DataBodyRange.Rows.Count
If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then ''Applies to items selected (ie visible) in the Budget Holder Table
BudHolder = Lobj.DataBodyRange(x, 3)
BudHolders(counter) = BudHolder
counter = counter + 1
End If
Next x
ReDim Preserve BudHolders(1 To counter - 1)
For x = LBound(BudHolders) To UBound(BudHolders)
With SlicCache
.ClearManualFilter
For Each SlicItem In .SlicerItems
If BudHolders(x) <> SlicItem.Value Then
SlicItem.Selected = False
End If
Next SlicItem
End With
‘Rest of code to do print PDF reports etc
End Sub
这就是 table 被称为 BudHolderList 的地方,pivottable 是 pivottable 1 和 slicer 被称为 Slicer_Budget_Holder.
Table:
枢轴:
我通过使用其中一个数据透视表而不是切片器找到了解决方法。因为所有表都是连接的(即所有表都将预算持有者作为过滤器字段并通过切片器连接),当我在数据透视 Table 的数据透视字段中更新预算持有者时,它将更新所有具有相同 PivotField 值的数据透视表。
所以替换原始问题中的切片器代码的代码很简单:
With sheets ("BudgetHolder").PivotTables("PivotTable1").PivotFields("BudgetHolder")
.ClearAllFilters
.CurrentPage=Budholder
End With
我正在尝试为选定的预算持有人(从预算持有人 Table 中选择)打印报告,使用预算持有人的姓名输入切片器,然后更新各种数据透视表 tables . 问题是代码选择切片器中的所有预算持有者,而不是选择我从 table.
中选择的单个预算持有者Sub PrintPDFsSO()
Dim Lobj As ListObject
Dim Budholder As String
Dim Path As String
Dim x As Long, y As Long, Number_of_rows As Long
Dim SourceBk As Workbook
Dim SlicItem As SlicerItem, SlicDummy As SlicerItem, SlicCache As SlicerCache
Dim pt As PivotTable, wb As Workbook, ws As Worksheet
Set SourceBk = ThisWorkbook
Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")
For x = 1 To Lobj.DataBodyRange.Rows.Count 'Budget Holders held in BudHolderList Table
Dim BudHolders()
ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count) 'as Budholders will only ever hold one budget hodler name, can this be simpified?
Dim Counter As Long
Counter = 1
If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then
Budholder = Lobj.DataBodyRange(x, 3) 'Name of budget holder held in 3rd column of Budget Holder Table
BudHolders(Counter) = Budholder 'Budholders holds the budget holder name
Counter = Counter + 1
ReDim Preserve BudHolders(1 To Counter - 1)
' Trying to stop slicers/pivot tables calculating so code setting new filter on budget name doesnt get stuck - but not working
Application.Calculation = xlCalculationManual
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = True
Next pt
Next ws
'Code to change budget holder in slicer to next budget holder in selection from Table
For y = LBound(BudHolders) To UBound(BudHolders)
With SlicCache
.ClearManualFilter 'clears all filters and shows all items in budget holder slicer
For Each SlicItem In .SlicerItems
If BudHolders(y) <> SlicItem.Value Then 'Tests if the slicer item matches the current a value of budholder
SlicItem.Selected = False 'Grinding to a virtual halt on this line as it 'calculates and populates pivot table report'
End If
Next SlicItem
End With
Next y
Application.Calculation = xlCalculationAutomatic
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = False
Next pt
Next ws
'Use budholder name which will populate some graphs etc in workbook with new figures
SourceBk.Sheets("Graphs - Summary").Range("BudHolder_SG").Value = Budholder
'Do Printing, saving etc
End If
Next
End Sub
能不能反过来把不需要的隐藏起来?以下代码基于从 table 中选取过滤器并应用于数据透视表 table。
注意:它将所有 table 个过滤器存储在一个数组中,然后循环此数组以将过滤器一次一个地应用于与枢轴关联的切片器。
您肯定希望使代码更加模块化,并将其分离为单独的函数/子过滤器的存储、数组循环和任何单独的操作,例如循环数组时生成报告 在移动设备上,缩进可能有点偏差。
Option Explicit
Sub PrintPDFs()
Dim Lobj As ListObject
Dim BudHolder As String
Dim SlicItem As SlicerItem, SlicCache As SlicerCache
Dim SourceBk As Workbook
Dim x As Long
Set SourceBk = ThisWorkbook
'Picks up Table with budget holder details
Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
'Picks up slicer which drives pivot tables in workbook
Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")
Dim BudHolders()
ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count)
Dim counter As Long
counter = 1
For x = 1 To Lobj.DataBodyRange.Rows.Count
If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then ''Applies to items selected (ie visible) in the Budget Holder Table
BudHolder = Lobj.DataBodyRange(x, 3)
BudHolders(counter) = BudHolder
counter = counter + 1
End If
Next x
ReDim Preserve BudHolders(1 To counter - 1)
For x = LBound(BudHolders) To UBound(BudHolders)
With SlicCache
.ClearManualFilter
For Each SlicItem In .SlicerItems
If BudHolders(x) <> SlicItem.Value Then
SlicItem.Selected = False
End If
Next SlicItem
End With
‘Rest of code to do print PDF reports etc
End Sub
这就是 table 被称为 BudHolderList 的地方,pivottable 是 pivottable 1 和 slicer 被称为 Slicer_Budget_Holder.
Table:
枢轴:
我通过使用其中一个数据透视表而不是切片器找到了解决方法。因为所有表都是连接的(即所有表都将预算持有者作为过滤器字段并通过切片器连接),当我在数据透视 Table 的数据透视字段中更新预算持有者时,它将更新所有具有相同 PivotField 值的数据透视表。
所以替换原始问题中的切片器代码的代码很简单:
With sheets ("BudgetHolder").PivotTables("PivotTable1").PivotFields("BudgetHolder")
.ClearAllFilters
.CurrentPage=Budholder
End With