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

残念ながら、Run time error 91: Object variable or With block variable not set が発生します。このエラーの原因は何ですか?

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"

当然、フィールドに個々の異なるアイテムがあるほど、これは遅くなります。ニーズに適している場合は、Nameの代わりにSourceNameを使用することもできます。

于 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

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 に答える
1

私はあなたの質問を理解していると思います。これにより、列ラベルまたは行ラベルにあるものがフィルタリングされます。コードの最後の2つのセクションはあなたが望むものですが、すべてを貼り付けて、定義されたすべてのもので最初から最後まで実行する方法を正確に確認できるようにします。このコードの一部は他のサイトfyi.

コードの終わり近くにある「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 には、スライサーと呼ばれる新しいツールがあります。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 に答える