我正在尝试基于两个单元格过滤两个数据透视表中的两个过滤器。这个想法是用户在两个单元格中输入信息，这两个枢轴将自动更新（两个过滤器）。
我正在使用此代码仅更新每个数据透视表中的一个过滤器：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
但是，我也想将单元格 d3 用于第二个过滤器。
我尝试了以下但它不起作用，只更新第一个过滤器：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
结束子
有什么我可能会丢失的吗？我对 VBA 很陌生
预先感谢您的帮助。
你好，我想通了，请看下图：
Private Sub Worksheet_Change(ByVal Target As Range) 'Update by Extendoffice 20180702 Dim xPTable As PivotTable Dim xPFile As PivotField Dim xStr As String On Error Resume Next
If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Range("d2").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Range("d2").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Range("d3").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Range("d3").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
结束子