如何为多个数据透视表选择数据透视表过滤器中的最后一项？

Question

我需要以下代码和数据透视表的帮助。

我每周运行一次脚本，每次需要时间时，请在下面的数据透视表（PivotTable1，PivotTable2和PivotTable3）中选择最后一个可用的项目：

我尝试了以下代码，但不起作用：

Dim pi As PivotItem
Dim lLoop As Long
Dim pt As PivotTable
Dim lCount As Long
Dim lWeeks As Long

On Error Resume Next
lWeeks = 1
If lWeeks = 0 Then Exit Sub

Application.ScreenUpdating = False
Set pt = ActiveSheet.PivotTables("PivotTable1")

    For Each pi In pt.PivotFields("Week").PivotItems
        pi.Visible = False
    Next pi

With pt.PivotFields("Week")
    For lLoop = .PivotItems.Count To 1 Step -1
        .PivotItems(lLoop).Visible = True
        lCount = lCount + 1
        If lCount = lWeeks Then Exit For
    Next lLoop
End With

On Error GoTo 0
Application.ScreenUpdating = True

我也尝试了以下方法，但仍无法正常工作：

Sheets("Pivot").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
    ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
    = ThisWorkbook.Worksheets("Pivot").Range("B2").Value

在这种情况下，我遇到运行时错误1004：无法获取Worksheet类的PivotTables属性。

您能否建议如何修改以上代码以选择“周”过滤器中的最后一个可用项目？

此外，如何修改此代码以选择这3个数据透视表的最后一个值？

谢谢。

Answer 1

您可以使用最后一个（或第一个）PivotItem的名称设置当前过滤器页面：

With ActiveSheet.PivotTables("PivotTable1").PageFields("Week")
    .ClearManualFilter        ' or ClearAllFilters
    .AutoSort xlAscending, .SourceName
    .CurrentPage = .Pivotitems(.Pivotitems.Count).Name
    If .CurrentPage = "(blank)" And .Pivotitems.Count > 1 Then
        .CurrentPage = .Pivotitems(.Pivotitems.Count - 1).Name
    End If
End With

如果最后一个条目为空白，则选择上一个。
如果您需要日期范围的另一端，只需将xlAscending更改为xlDescending。

---

您可以遍历工作表中的所有数据透视表，并通过以下方法将每个过滤器设置为最后一页：

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
For Each pt In ActiveSheet.PivotTables
    pt.RefreshTable
    ' Set pf = pt.PageFields("Week")
    For Each pf In pt.PageFields
        pf.ClearManualFilter        ' or ClearAllFilters
        pf.EnableMultiplePageItems = True
        pf.AutoSort xlAscending, pf.SourceName
        pf.CurrentPage = pf.Pivotitems(pf.Pivotitems.Count).Name
        If pf.CurrentPage = "(blank)" And pf.Pivotitems.Count > 1 Then
            pf.CurrentPage = pf.Pivotitems(pf.Pivotitems.Count - 1).Name
        End If
    Next pf
Next pt

---

至少有一项必须保持可见，因此您不能循环显示所有项并将其设置为.Visible = False。除了最后一个PivotItem以外的所有循环都应该起作用，但速度太慢。

---

我添加了.RefreshTable来刷新数据透视表中的数据。如果仍然有错误的信息，则可以另外刷新工作簿的PivotCache：

Dim pc As PivotCache
For Each pc In ActiveWorkbook.PivotCaches
    pc.MissingItemsLimit = xlMissingItemsNone
    pc.Refresh
Next pc