14

我现在一直尝试从互联网上复制和粘贴解决方案，以尝试使用 VBA 在 Excel 中过滤数据透视表。下面的代码不起作用。

Sub FilterPivotTable()
    Application.ScreenUpdating = False
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = "K123223"
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
    Application.ScreenUpdating = True
End Sub

我想过滤，所以我看到所有具有 SavedFamilyCode K123223 的行。我不想在数据透视表中看到任何其他行。无论以前的过滤器如何，我都希望它能够正常工作。我希望你能帮我解决这个问题。谢谢！

根据您的帖子，我正在尝试：

Sub FilterPivotField()
    Dim Field As PivotField
    Field = ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode")
    Value = Range("$A$2")
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating fields that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

不幸的是，我得到运行时错误 91：对象变量或未设置块变量。是什么导致了这个错误？

4

6 回答 6

12

Field.CurrentPage 仅适用于过滤器字段（也称为页面字段）。
如果要过滤行/列字段，则必须循环浏览各个项目，如下所示：

Sub FilterPivotField(Field As PivotField, Value)
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating PivotItems that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

然后，您只需调用：

FilterPivotField ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode"), "K123223"

自然，该字段中的单个不同项目越多，这就会越慢。如果更适合您的需要，您也可以使用 SourceName 而不是 Name。

于 2012-06-17T22:10:21.797 回答
9

配置数据透视表，使其如下所示：

在此处输入图像描述

您的代码现在可以简单地在 range("B1") 上工作，并且数据透视表将被过滤为您所需的 SavedFamilyCode

Sub FilterPivotTable()
Application.ScreenUpdating = False
    ActiveSheet.Range("B1") = "K123224"
Application.ScreenUpdating = True
End Sub
于 2012-06-17T20:31:45.703 回答
6

如果你愿意，你可以检查一下。:)

如果 SavedFamilyCode 在报告过滤器中，请使用此代码：

 Sub FilterPivotTable()
   Application.ScreenUpdating = False
   ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = _
      "K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

但如果 SavedFamilyCode 位于列或行标签中，请使用以下代码：

 Sub FilterPivotTable()
     Application.ScreenUpdating = False
     ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").PivotFilters. _
    Add Type:=xlCaptionEquals, Value1:="K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

希望这对您有所帮助。

于 2015-09-18T06:51:40.280 回答
1

我想我理解你的问题。这会过滤列标签或行标签中的内容。代码的最后 2 部分是您想要的，但我粘贴了所有内容，以便您可以准确地看到它是如何运行的，从定义的所有内容开始到结束等等。我肯定从其他站点获取了一些代码，仅供参考。

在代码末尾附近，“WardClinic_Category”是我的数据列，位于数据透视表的列标签中。IVUDDCIndicator 也是如此（它在我的数据中是一列，但在数据透视表的行标签中）。

希望这对其他人有所帮助...我发现很难找到以“正确方式”执行此操作的代码，而不是使用类似于宏记录器的代码。

Sub CreatingPivotTableNewData()


'Creating pivot table
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim PvtTblCache As PivotCache
Dim wsPvtTbl As Worksheet
Dim pvtFld As PivotField

'determine the worksheet which contains the source data
Set wsData = Worksheets("Raw_Data")

'determine the worksheet where the new PivotTable will be created
Set wsPvtTbl = Worksheets("3N3E")

'delete all existing Pivot Tables in the worksheet
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property.
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl


'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache.

'set source data range:
Worksheets("Raw_Data").Activate
Set rngData = wsData.Range(Range("A1"), Range("H1").End(xlDown))


'Creates Pivot Cache and PivotTable:
Worksheets("Raw_Data").Activate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData.Address, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")

'Default value of ManualUpdate property is False so a PivotTable report is recalculated automatically on each change.
'Turn this off (turn to true) to speed up code.
PvtTbl.ManualUpdate = True


'Adds row and columns for pivot table
PvtTbl.AddFields RowFields:="VerifyHr", ColumnFields:=Array("WardClinic_Category", "IVUDDCIndicator")

'Add item to the Report Filter
PvtTbl.PivotFields("DayOfWeek").Orientation = xlPageField


'set data field - specifically change orientation to a data field and set its function property:
With PvtTbl.PivotFields("TotalVerified")
.Orientation = xlDataField
.Function = xlAverage
.NumberFormat = "0.0"
.Position = 1
End With

'Removes details in the pivot table for each item
Worksheets("3N3E").PivotTables("PivotTable1").PivotFields("WardClinic_Category").ShowDetail = False

'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("WardClinic_Category").PivotItems
    Select Case PivotItem.Name
        Case "3N3E"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem


'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("IVUDDCIndicator").PivotItems
    Select Case PivotItem.Name
        Case "UD", "IV"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem

'turn on automatic update / calculation in the Pivot Table
PvtTbl.ManualUpdate = False


End Sub
于 2015-06-05T15:37:13.633 回答
1

最新版本的 Excel 有一个名为 Slicers 的新工具。在 VBA 中使用切片器实际上比 .CurrentPage 更可靠（在循环多个过滤器选项时有错误报告）。这是一个简单示例，说明如何选择切片器项目（请记住取消选择所有不相关的切片器值）：

Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long
Dim searchName as string

Application.ScreenUpdating = False
searchName="Value1"

    For Each slItem In .VisibleSlicerItems
        If slItem.Name <> .SlicerItems(1).Name Then _
            slItem.Selected = False
        Else
            slItem.Selected = True
        End if
    Next slItem
End Sub

还有像 SmartKato 这样的服务可以帮助您设置仪表板或报告和/或修复您的代码。

于 2015-08-10T04:12:26.677 回答
1

在 Excel 2007 及更高版本中，您可以使用更简单的代码和更精确的参考：

dim pvt as PivotTable
dim pvtField as PivotField

set pvt = ActiveSheet.PivotTables("PivotTable2")
set pvtField = pvt.PivotFields("SavedFamilyCode")

pvtField.PivotFilters.Add xlCaptionEquals, Value1:= "K123223"
于 2015-08-14T11:04:42.930 回答