Grafit：您发布的两个代码 sn-ps 做了非常不同的事情。第一个使除值“（leeg）”之外的所有内容都可见。第二个使任何带有“BSO”的项目可见，并隐藏其他所有项目。两段代码都有问题。
关于您的第一个代码 sn-p，如果您想显示除名为“(leeg)”的项目之外的所有项目，则无需遍历 PivotItems 集合（在大型 Pivot 上确实很慢） .相反，只需这样做：
pf.ClearAllFilters
pf.PivotItems("leeg").visible = false
关于您的第二段代码，是的，错误可能是由 MissingItemsLimit 问题引起的，但如果代码尝试隐藏 PivotItem 而在循环期间当前没有其他 PivotItem 可见，也会发生此错误。例如，如果您对数据透视表进行了过滤，例如“Aardvark”，那么由于“Aardvark”中没有“BSO”，代码将尝试隐藏它，然后会出错，因为在至少一个 PiovtItem 必须始终保持可见。
因此，您要做的就是在循环之前添加一行 ，使 PivotItems 集合中的 last 项可见，这样您几乎可以保证一个项目将一直可见到循环结束。
（当然，如果“BSO”没有出现在任何 PivotItems 中，那么当您去处理最后一个项目时，您仍然会收到错误消息）。
此外，每当您遍历 PivotITems 集合时，您通常希望将 PT.ManualUpdate 设置为 True，这样数据透视表就不会在每个项目被隐藏/取消隐藏后尝试更新数据透视表中的总计。然后在例程结束时再次将 PT.ManualUpdate 设置为 False，然后告诉 Excel “我完成了……您现在可以更新这些数据透视表总计。”这通常会在您的例行程序速度方面产生惊人的差异。在大型枢轴上，您将节省大量时间。
我在http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/ 写了一篇深入讨论这些内容的文章，建议您查看。
--edit-- 这是一个清除数据透视表以便只显示一个项目的例程：
Sub FilterPivot_PivotItem(pfOriginal As PivotField, _
Optional pi As PivotItem, _
Optional pfTemp As PivotField, _
Optional bDelete_wksTemp As Boolean = True, _
Optional bDelete_ptTemp As Boolean = False)
' If pfOriginal is a PageField, we'll simply turn .EnableMultipleItems to FALSE
' and select pi as a PageField
' Otherwise we'll
' * create a temp copy of the PivotTable
' * Make the field of interest a PageField
' * Turn .EnableMultipleItems to FALSE and select pi as a PageField
' * Add a Slicer to that PageField
' * Connect that Slicer to pfOriginal, which will force it instantly to sync.
' to pfTemp, meaning it shows just one item
' This is much faster than Iterating through a large PivotTable and setting all but
' one item to hidden, as outlined at http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/
Const sRoutine = "FilterPivot_PivotItem"
Dim sc As SlicerCache
Dim bSlicerExists As Boolean
Dim ptOriginal As PivotTable
Dim ptTemp As PivotTable
Dim wksTemp As Worksheet
Dim bDisplayAlerts As Boolean
Dim lCalculation As Long
Dim bEnableEvents As Boolean
Dim bScreenUpdating As Boolean
Dim TimeTaken As Date
TimeTaken = Now()
Set ptOriginal = pfOriginal.Parent
With Application
bScreenUpdating = .ScreenUpdating
bEnableEvents = .EnableEvents
lCalculation = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With pfOriginal
If pi Is Nothing Then Set pi = .PivotItems(1)
If .Orientation = xlPageField Then
'Great: we're dealing with a field in the FILTERS pane, which let us
' select a singe item easily
.EnableMultiplePageItems = False
.CurrentPage = pi.Name
Else
' For non PageFields we'll have to use a temp PivotTable and Slicer to quickly clear
' all but one PivotItem.
'Check if pfOriginal already has a slicer connected
' If so, then we'll want to leave it in place when we're done
bSlicerExists = Slicer_Exists(ptOriginal, pfOriginal)
' A temp PivotTable may aleady exist and have been passed in when the function was called
' Otherwise we'll need to create one.
If pfTemp Is Nothing Then
Set wksTemp = Sheets.Add
Set ptTemp = ptOriginal.PivotCache.CreatePivotTable(TableDestination:=wksTemp.Range("A1"))
Set pfTemp = ptTemp.PivotFields(.SourceName)
'Set the SaveData state of this new PivotTable the same as the original PivotTable
'(By default it is set to True, and is passed on to the original PivotTable when a Slicer is connected)
If ptTemp.SaveData <> ptOriginal.SaveData Then ptTemp.SaveData = ptOriginal.SaveData
Else
Set ptTemp = pfTemp.Parent
'Check if pfTemp already has a slicer conneced.
If Not Slicer_Exists(ptTemp, pfTemp, sc) Then Set sc = ActiveWorkbook.SlicerCaches.Add(ptTemp, pfTemp)
End If
ptTemp.ManualUpdate = True
With pfTemp
.Orientation = xlPageField
.EnableMultiplePageItems = False
.CurrentPage = pi.Name
End With
ptTemp.ManualUpdate = False
'Connect slicer on pfTemp to pfOriginal to pass through settings, then disconnect it
sc.PivotTables.AddPivotTable pfOriginal.Parent
If Not bSlicerExists Then
sc.Delete
Else
sc.PivotTables.RemovePivotTable pfTemp.Parent
End If
If bDelete_wksTemp Then
bDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
wksTemp.Delete
Application.DisplayAlerts = bDisplayAlerts
ElseIf bDelete_ptTemp Then ptTemp.TableRange2.ClearContents
End If
End If
End With
With Application
.ScreenUpdating = bScreenUpdating
.EnableEvents = bEnableEvents
.Calculation = lCalculation
End With
TimeTaken = Now() - TimeTaken
Debug.Print Now() & vbTab & sRoutine & " took " & Format(TimeTaken, "HH:MM:SS") & " seconds."
End Sub