Excel数据透视表过滤器链接到单元格

时间:2018-08-26 20:12:38

标签: excel vba excel-vba

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

我修改了网上找到的代码,以与我的工作簿一起使用,

  • 将单元格链接到我的数据透视表过滤器;
  • 在单元格被更新或激活后,更新过滤器并刷新数据透视表;

效果很好。挑战在于,在同一工作表上有2个数据透视表,我需要同时过滤2个表。此外,过滤器数据也不同,因此尽管过滤器会同时更改,但过滤器应链接到不同的单元格。

我正在使用的代码如下。现在有PivotTable1PivotTable2;单元格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

1 个答案:

答案 0 :(得分:1)

您的代码可以进行如下修改...

--memory-swap

尽管如此,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
相关问题