Pivot-Tabellenbericht - Filtern aus Zellinhalten
13.08.2017 10:42:16
fcs
Hallo SJ,
Wie ist es hier möglich eine Mehrfachauswahl zu treffen, auf Basis der kopierten Daten?
Das ist leider nicht ganz so einfach.
Man muss den Filter für das Seitenfeld zurücksetzen, die Mehrfach-Auswahl aktivieren und dann alle für alle Regionen, die in den selektierten Regionen nicht vorhanden sind, die Eigenschaft Visible auf False setzen. Dann gibt es noch die Sonderfälle "leere Zelle" und "", die man extra behandeln muss.
Damit es keine Probleme mit Karteileichen gibt (Items, die mal vorhanden waren, dann aber wieder gelöscht wurden/nicht mehr vorkommen) muss folgende Option für den Pivotbericht unbedingt gesetzt werden:
Gruß
Franz
Sub Kopieren_Filterelemente()
'Kopieren der Auswertung
Dim rngFilter As Range, rngZelle As Range
Dim pvField As PivotField, pvItem As PivotItem, bolSelect As Boolean
Dim wksSelect As Worksheet
Set wksSelect = Worksheets("Tabelle1") 'Name des Blattes in dem die Zellen mit den _
Filterkriterien ausgewählt werden - ggf. anpassen
With wksSelect
.Activate
.Range("A40:A45").Select 'bleibt das fix? oder ändert sich dass ständig? - wenn _
variabel, dann diese Zeile weglassen - wenn Fix,dann sollte man etwas _
anders programmieren
Set rngFilter = Selection
.Range("M5").Resize(20, 1).ClearContents 'Alte kriterien in M5:M25 löschen
rngFilter.Copy Destination:=.Range("M5")
Set rngFilter = ActiveSheet.Range("M5").Resize(rngFilter.Rows.Count, 1)
End With
' Auswahl der kopierten Merkmale im Filter für Regionen setzen
With Sheets("Original").PivotTables(1)
.RefreshTable
Set pvField = .PageFields("Region")
With pvField
'Filter im Feld zurücksetzen
.ClearAllFilters
If .EnableMultiplePageItems = False Then .EnableMultiplePageItems = True
For Each pvItem In .PivotItems
bolSelect = False
For Each rngZelle In rngFilter
If IsEmpty(rngZelle) And (pvItem = "(blank)" Or pvItem = "(Leer)") Then
bolSelect = True
Exit For
ElseIf rngZelle.Text = "" And pvItem = "" Then
bolSelect = True
Exit For
ElseIf rngZelle.Text = pvItem.Caption Then
bolSelect = True
Exit For
End If
Next
If bolSelect = False Then
pvItem.Visible = False
End If
Next
End With
.Parent.Activate
.TableRange2.Range("A1").Select
End With
End Sub