Vba Excel数据透视表筛选器链接到单元格

我是一个VBA新手，已经发布了这个问题，但是我不得不在我的工作簿中重新做一些表格，最初的问题最终不准确，因此再次尝试

我已修改了联机找到的代码以使用我的工作簿，其中：

将单元格链接到“我的数据透视表”筛选器； 更新或激活单元格后，更新过滤器并刷新数据透视表； 效果很好。挑战在于同一工作表上有两个数据透视表，我需要同时筛选两个表。此外，过滤器数据也不同，因此过滤器应链接到不同的单元格，尽管它们在同一时间发生变化

我使用的代码如下。现在有数据透视表1和数据透视表2；单元格H6的条目链接到第一个表，H7链接到另一个表。在这一点上有点不知所措，但这应该可以在同一个代码中实现，对吗

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("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets("Sheet1").Range("H6").Value

'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With

End Sub

---

您的代码可以修改如下

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 vPivotTableNames As Variant
    Dim vNewCats As Variant
    Dim i As Long

    'Assign the pivottable names to a variable
    vPivotTableNames = Array("PivotTable1", "PivotTable2")

    'Assign the new categories to a variable
    vNewCats = Range("H6:H7").Value

    'Update the pivotables
    For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
        Set pt = Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
        Set Field = pt.PivotFields("Category")
        With Field
            .ClearAllFilters
            .CurrentPage = vNewCats(i + 1, 1)
        End With
        pt.RefreshTable
    Next i

End Sub

'Update the pivotables
For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
    With Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
        With .PivotFields("Category")
            .ClearAllFilters
            .CurrentPage = vNewCats(i + 1, 1)
        End With
        .RefreshTable
    End With
Next i

尽管如此，For/Next循环可以按如下方式重新编写

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 vPivotTableNames As Variant
    Dim vNewCats As Variant
    Dim i As Long

    'Assign the pivottable names to a variable
    vPivotTableNames = Array("PivotTable1", "PivotTable2")

    'Assign the new categories to a variable
    vNewCats = Range("H6:H7").Value

    'Update the pivotables
    For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
        Set pt = Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
        Set Field = pt.PivotFields("Category")
        With Field
            .ClearAllFilters
            .CurrentPage = vNewCats(i + 1, 1)
        End With
        pt.RefreshTable
    Next i

End Sub

'Update the pivotables
For i = LBound(vPivotTableNames) To UBound(vPivotTableNames)
    With Worksheets("Sheet1").PivotTables(vPivotTableNames(i))
        With .PivotFields("Category")
            .ClearAllFilters
            .CurrentPage = vNewCats(i + 1, 1)
        End With
        .RefreshTable
    End With
Next i

---

这对一张桌子有用吗？是否已将其展开以过滤第二个表？使用您拥有的代码很容易做到这一点。