Grafit: あなたが投稿した 2 つのコード スニペットは、非常に異なることを行います。最初のものは、値 "(leeg)" を除くすべてを表示します。2 つ目は、「BSO」が含まれるアイテムを表示し、それ以外はすべて非表示にします。コードの両方のビットに問題があります。
最初のコード スニペットに関して、"(leeg)" という名前のアイテムを除くすべてのアイテムを表示する場合、PivotItems コレクションを反復処理する必要はありません (大きなピボットでは非常に遅くなります)。代わりに、次のようにします。
pf.ClearAllFilters pf.PivotItems("足").visible = false
2番目のコードに関しては、MissingItemsLimitの問題が原因でエラーが発生する可能性がありますが、ループ中に他のPivotItemsが現在表示されていないときにコードがPivotItemを非表示にしようとした場合にも発生します. たとえば、ピボットテーブルを "Aardvark" などの 1 つのアイテムだけでフィルター処理した場合、"Aardvark" には "BSO" が含まれていないため、コードはそれを非表示にしようとし、エラーになります。少なくとも 1 つの PiovtItem が常に表示されている必要があります。
そのため、ループの前に PivotItems コレクションの最後の項目を表示する行を追加する必要があります。これにより、1 つの項目がループの最後まで表示されたままになることがほぼ保証されます。
(もちろん、「BSO」がどのピボットアイテムにも表示されない場合でも、最後のアイテムを処理しようとするとエラーが発生します)。
さらに、PivotITems コレクションを反復処理するたびに、通常は PT.ManualUpdate を True に設定して、すべてのアイテムが非表示/非表示になった後にピボットテーブルがピボットテーブルの合計を更新しようとしないようにします。次に、ルーチンの最後に PT.ManualUpdate を再度 False に設定すると、Excel に「完了しました...これらのピボットテーブルの合計を今すぐ更新できます」と通知されます。これは通常、ルーチンの速度に関して驚くべき違いをもたらします. 大きなピボットでは、多くの時間を節約できます。
このことについて詳しく説明した記事をhttp://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/で書いたので、ぜひチェックしてみてください。
--edit-- 1 つの項目だけが表示されるようにピボットテーブルをクリアするルーチンは次のとおりです。
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