我已经使用https://www.mrexcel.com/forum/excel-questions/950078-filtering-pivot-table-based-cell-value.html创建了以下代码,但出现错误
Set Field = pt.PivotFields("EmployeeName")
是在说
Unable to get the PivotFields property of the PivotTable class
尽管EmployeeName
是我的数据透视表中的一个字段。现在,我确实在数据模型中有2个数据库,它们都以EmployeeName
作为字段,并且通过关系链接。我是否需要指定要使用的数据库以及该如何做?我的脚本在下面供参考。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
'Here you amend to suit your data
Set pt = Worksheets("2018IndSales").PivotTables("PivotTable4")
Set Field = pt.PivotFields("EmployeeName")
NewCat = Worksheets("2018IndSales").Range("H6").Value
'This updates and refreshes the PIVOT table
With Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName")
.ClearAllFilters
.PivotFilters.Add Type:=xlCaptionEquals, Value1:=Worksheets("2018IndSales").Range("H6").Value
End With
End Sub
尝试一下
Private Sub Worksheet_Change(ByVal Target As Range)
'This macro will run if H6 is CHANGED
If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
'Application.ScreenUpdating = False
ThisWorkbook.Activate
Worksheets("2018IndSales").PivotTables("PivotTable4").PivotCache.Refresh
Dim i As Long
'i = Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName").PivotItems(Worksheets("2018IndSales").Range("A2").Value).Position
i = Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName").PivotItems(Worksheets("2018IndSales").Range("H6").Value).Position
Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName"). _
ClearLabelFilters
Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName").PivotFilters. _
Add2 Type:=xlCaptionEquals, Value1:=Worksheets("2018IndSales").PivotTables("PivotTable4").PivotFields("EmployeeName").PivotItems(i).Value
'Application.ScreenUpdating = False
End Sub