Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pivot Filter aufgrund von Variablen setzen

Pivot Filter aufgrund von Variablen setzen
19.02.2014 15:41:22
Variablen
Schönen guten Tag!
Ich habe ein funktionierndes Makro das mir in einem Tabellenblatt einen Pivotfilter immer um eins weiter setzt und die restlichen Filter ausblendet.
Leider dürfte das Makro das recht umständlich machen da immer alle ein und alle ausgeblendet werden und nur der aktuelle "Count" übrigbleibt.
Kann ich da nicht gleich aus einer Liste die Filter auslesen damit das schneller von statten geht?
Sprich:
1. Schritt: Alle Filter löschen
2. Schritt: Variable aus Liste auslesen und festlegen
3. Schritt: Filter aufgrund der Variable setzen

Sub Pivot_Drucken_RM()
Dim pt                   As PivotTable
Dim pi                   As PivotItem
Dim pf                   As PivotField
Dim piCount              As Integer
Dim piAct                As Integer
Set pt = Worksheets("RG").PivotTables("Pivot1")
Set pf = pt.PivotFields("RG")
For piAct = 1 To pf.PivotItems.Count
Sheets(Array("RG")).Select
pt.ManualUpdate = True
pf.ClearAllFilters
For piCount = 1 To pf.PivotItems.Count
If pf.PivotItems(piCount)  pf.PivotItems(piAct) Then
pf.PivotItems(piCount).Visible = False
End If
Next piCount
pt.ManualUpdate = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\" & "TEST_" & Cells(15, 2) & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next piAct
End Sub

Vielen Dank!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivot Filter aufgrund von Variablen setzen
20.02.2014 11:53:49
Variablen
Hallo Thomas,
nachfolgend ein angepasster Code, der die Pivotitems erst in ein Array einliest und dann direkt den Filter setzt. Es geht allerdings nicht ohne zwischendurch immer den Filter zu löschen
Gruß
Franz
'Erstellt unter Excel 2010
Sub Pivot_Drucken_RM()
Dim pt                   As PivotTable
Dim pi                   As PivotItem
Dim pf                   As PivotField
Dim piCount              As Integer
Dim arrPi()              As Variant
Dim strFile               As String
Sheets("RG").Select
Set pt = Worksheets("RG").PivotTables("Pivot1")
Set pf = pt.PivotFields("RG")
pt.RefreshTable
pf.ClearAllFilters
'angezeigte Pivotitems des Feldes in Array erfassen
piCount = 0
For Each pi In pf.PivotItems
If pi.RecordCount > 0 Then
piCount = piCount + 1
ReDim Preserve arrPi(1 To piCount)
arrPi(piCount) = pi.Name
End If
Next pi
Application.ScreenUpdating = False
For piCount = 1 To UBound(arrPi)
Application.StatusBar = "PDF für " & arrPi(piCount) _
& " (" & piCount & " von " & UBound(arrPi) & ") wird erstellt."
pf.PivotFilters.Add Type:=xlCaptionEquals, Value1:=arrPi(piCount)
pt.Update
strFile = "TEST_" & Cells(15, 2) & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\" & strFile & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
pf.ClearAllFilters
Next piCount
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub

Anzeige

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige