Как применить фильтр к моей сводной диаграмме в VBA - PullRequest
3 голосов
/ 28 июня 2019

Я пытаюсь написать макрос для создания сводной диаграммы. Мне нужно, чтобы сводная диаграмма была гистограммой, в которой столбцы отфильтрованы, чтобы показать только 3 из столбцов. Вот код, который у меня есть.

'Define Data Range
LastRow = Dsheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = Dsheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = Dsheet.Cells(1, 1).Resize(LastRow, LastCol)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange)

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Studies Impacted")

'Insert Column Fields
 With ActiveSheet.PivotTables("Studies Impacted").PivotFields("Study")
    .Orientation = xlColumnField
    .Position = 1
End With

'Insert Row Fields
With ActiveSheet.PivotTables("Studies Impacted").PivotFields("Workstream")
    .Orientation = xlRowField
    .Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("Studies Impacted").PivotFields("Study")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlCount
    .NumberFormat = "#,##0"
    .Name = "Status Count"
End With


'Format Pivot
ActiveSheet.PivotTables("Studies Impacted").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("Studies Impacted").TableStyle2 = "PivotStyleMedium9"

Я пытался использовать> add FilterType, но он не работает. Я также попытался определить его как PivotField, но, опять же, безрезультатно.

Результат, который я хочу получить, - это гистограмма, в которой показано только 3 исследования для каждого потока работ. Вместо этого я получаю все исследования.

1 Ответ

1 голос
/ 29 июня 2019

Я предполагаю, что ваша сводная диаграмма и таблица связаны.

Вы можете отфильтровать до двух элементов, используя метод

pvtField.ActiveFilters.Add2

(Excel 2013 или более поздняя версия) или

pvtField.ActiveFilters.Add

(ранее Excel 2013)

Вы бы запустили код, подобный этому

Sub main()
Dim pvtTable As PivotTable
Dim pvtFields As PivotFields
Dim pvtField As PivotField
Dim ws As Worksheet

Set ws = ActiveSheet
Set pvtTable = ws.PivotTables(1)
pvtTable.AllowMultipleFilters = True

Set pvtFields = pvtTable.PivotFields
Set pvtField = pvtFields.Item(1)
pvtField.PivotFilters.Add2 xlCaptionEquals, Value1:="A", Value2:="B"
End Sub

В противном случае вы должны перебрать все сводные элементы фильтруемой строки

CODE:

Option Explicit

Sub main()
Dim ws As Worksheet
Dim pvtTable As PivotTable
Dim pvtItems As PivotItems
Dim pvtItem As PivotItem
Dim Index As Long

Set ws = ActiveSheet
Set pvtTable = ws.PivotTables(1)
Set pvtItems = pvtTable.PivotFields(1).PivotItems

For Index = 1 To pvtItems.Count
    Set pvtItem = pvtItems.Item(Index)
    If pvtItem.Value = "A" Or pvtItem.Value = "B" Then
        pvtItem.Visible = False
    End If
Next Index
End Sub

enter image description here

enter image description here

...