Question

这是我的功能，代码在第一次迭代（第17行）的“ If pitem.visible = True”行停止。在代码运行时，我在该字段中始终有可见项。该代码甚至没有将任何属性设置为可见，并且如果我过滤除日期以外的任何内容，它都可以很好地工作。

Function tableau()

    Dim fld As PivotField
    Dim pitem As PivotItem
    Dim i As Long
    Dim arr() As Variant
    Dim a As String
    Dim pvt As String

pvt = "PivotTable"
Sheets("Données").ListObjects("table1").AutoFilter.ShowAllData
Sheets("PivotTableSheet").Activate
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = True
Sheets("PivotTableSheet").PivotTables(pvt).PivotFields("Date").EnableMultiplePageItems = True


For Each fld In Sheets("PivotTableSheet").PivotTables(pvt).PivotFields
        If fld.Orientation <> xlHidden And (fld.Orientation = xlPageField) Then        'loop through filtered pivot fields
            i = 1
            For Each pitem In fld.PivotItems                                           'loop through visible items in filtered pivot fields
                If pitem.Visible = True Then
                    ReDim Preserve arr(1 To i) As Variant
                    arr(i) = pitem
                    i = i + 1
                End If
            Next pitem
            Sheets("Données").ListObjects("table1").Range.AutoFilter Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues
        End If

    Next fld
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = False

End Function

Answer 1

如果您要做的就是使每个PivotItem可见，则不必遍历PivotItems。相反，只需使用.ClearAllFilters方法。

类似的东西：

  With Sheets("PivotTableSheet").PivotTable("PivotTable").PivotFields("Date")
        .ClearAllFilters
        .CurrentPage = "(All)"
    End With

Answer 2

在PivotItems上进行迭代时，您要避免几个瓶颈和陷阱。有关更多信息，请参见我在http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/上的帖子。

除其他事项外，您希望在执行迭代时将数据透视表的ManualUpdate属性设置为TRUE，然后在完成时将其设置为FALSE。否则，每次您更改数据透视表的可见性时，Excel都会尝试更新数据透视表。并且您还想确保至少有一个项目始终保持可见状态。我用这样的东西：

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vItems As Variant

Set pt = ActiveSheet.PivotTables("PivotTable1") '<= Change to match your PivotTable
Set pf = pt.PivotFields("CountryName") '<= Change to match your PivotField

vItems = Array("FRANCE", "BELGIUM", "LUXEMBOURG") '<= Change to match the list of items you want to remain visible

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible        
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vItems
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the countries of interest
    On Error Resume Next
    If InStr(UCase(Join(vItems, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub

VBA过滤日期

2 个答案: