Загрузочная флешка

 

VBA сводная таблица с фильтрами

 Подскажите как сделать фильтр по определенному значению в сводной таблице, например в строках "Подразделение"

Листинг программы

   
sub test()
 
    Set rngStart = Worksheets("TDSheet").Range("A1") 
    Set rngAll = rngStart.CurrentRegion
    Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngAll.Address) 
    Worksheets.Add 
    Set pvtOne = ActiveSheet.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=Range("a1")) 
        
        With pvtOne
            .PivotFields("Подразделение").Orientation = xlRowField 
            .PivotFields("Контрагент").Orientation = xlRowField 
            .PivotFields("Регистратор").Orientation = xlDataField   
            .PivotFields("Плата").Orientation = xlColumnField 
            .RowAxisLayout xlTabularRow
            .RepeatAllLabels xlRepeatLabels
            .PivotFields("Подразделение").Subtotals(1) = False
         End With
 
end sub

Код к задаче: «Фильтр в сводной таблице»

Листинг программы

    Dim pvtItem As PivotItem
    With pvtOne
        With .PivotFields("Подразделение")
            For Each pvtItem In .PivotItems
                        Select Case pvtItem
                            Case "Работа с клиентами", "Закупки", "Аналитический отдел"
                                pvtItem.Visible = True
                            Case Else
                                pvtItem.Visible = False
                        End Select
            Next pvtItem
        End With
    End With

Полезно ли:

VBA Сводная таблица

Sub PivotTable()

Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim LR As Long
Dim LC As Long

On Error Resume NextError Resume NextVBA On Error Resume Statement is an error-handling aspect used for ignoring the code line because of which the error occurred and continuing with the next line right after the code line with the error.read more
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Pivot Sheet").Delete 'This will delete the exisiting pivot table worksheet
Worksheets.Add After:=ActiveSheet ' This will add new worksheet

ActiveSheet.Name = "Pivot Sheet" ' This will rename the worksheet as "Pivot Sheet"
On Error GoTo 0

Set PSheet = Worksheets("Pivot Sheet")
Set DSheet = Worksheets("Data Sheet")

'Find Last used row and column in data sheet
LR = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LC = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column

'Set the pivot table data range
Set PRange = DSheet.Cells(1, 1).Resize(LR, LC)

'Set pivot cahe
Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=PRange)

'Create blank pivot table

Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="Sales_Report")

'Insert country to Row Filed
With PSheet.PivotTables("Sales_Report").PivotFields("Country")
.Orientation = xlRowField
.Position = 1
End With

'Insert Product to Row Filed & position 2
With PSheet.PivotTables("Sales_Report").PivotFields("Product")
.Orientation = xlRowField
.Position = 2
End With

'Insert Segment to Column Filed & position 1
With PSheet.PivotTables("Sales_Report").PivotFields("Segment")
.Orientation = xlColumnField
.Position = 1
End With

'Insert Sales column to the data field
With PSheet.PivotTables("Sales_Report").PivotFields("Sales")
.Orientation = xlDataField
.Position = 1
End With

'Format Pivot Table
PSheet.PivotTables("Sales_Report").ShowTableStyleRowStripes = True
PSheet.PivotTables("Sales_Report").TableStyle2 = "PivotStyleMedium14"

'Show in Tabular form
PSheet.PivotTables("Sales_Report").RowAxisLayout xlTabularRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub