Multiselect aus Pivot auslesen

Hallo,
wie kann ich die ausgewählten Filter bei einem Pivot Multiselect auslesen und in einer anderen Zelle oder mehreren Zellen anzeigen lassen?
Beispiel:
Die Basisdaten beinhalten Daten der Jahre 2000-2013.
Darauf wird eine Pivottabelle gelegt.
Das Feld Jahr ziehe ich in den Pivot-Berichtsfilter.
Ich wähle dann "Mehrere Elemente asuswählen" und wähle das Jahr 2011 und das Jahr 2013.
Es soll dann in einer anderen Zelle 2011, 2013 stehen bzw. in zwei Zellen untereinander.
Danke und Gruß
zur Info:
Ich habe aus einem früheren Beitrag bereits einen Code bekommen, der die Multiselectfelder ausliest und diese auf eine andere Pivot überträgt.
Archivnummer:
1334523
ich weiß aber nicht wo im Code ich eingreifen kann, dass der Code mir die gewählten Fitler in deine Zelle schreibt.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo David,
hier entsprechende Makros für beide Varianten.
Gruß
Franz

'Code unter dem Tabellenblatt mit dem Pivottabellenbericht
Option Explicit
'Variante 1: Alle Filter in eine Zelle schreiben
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pvField As PivotField, pvItem As PivotItem
Dim Startzelle As Range
Set Startzelle = Me.Range("F1") 'Zelle in die Filterwerte eingetragen werden sollen
Set pvField = Target.PageFields("Jahr")
'Alte Einträge löschen
Startzelle.ClearContents
If pvField.EnableMultiplePageItems = True Then
If pvField.LabelRange.Offset(0, 1).Text = "(Mehrere Elemente)" Then
For Each pvItem In pvField.PivotItems
If pvItem.Visible = True Then
If Startzelle = "" Then
Startzelle.Value = "'" & pvItem.Value
Else
Startzelle.Value = "'" & Startzelle.Value & "; " & pvItem.Value
End If
End If
Next
End If
End If
End Sub
'Variante 2: Filter ab Startzelle in Zellen untereinander
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pvField As PivotField, pvItem As PivotItem, intOffset As Integer
Dim Startzelle As Range
Set Startzelle = Me.Range("F1") 'Zelle ab der Filterwerte eingetragen werden sollen
Set pvField = Target.PageFields("Jahr")
'Alte Einträge löschen
Do While Startzelle.Offset(intOffset, 0)  ""
Startzelle.Offset(intOffset, 0).ClearContents
intOffset = intOffset + 1
Loop
intOffset = 0
If pvField.EnableMultiplePageItems = True Then
If pvField.LabelRange.Offset(0, 1).Text = "(Mehrere Elemente)" Then
For Each pvItem In pvField.PivotItems
If pvItem.Visible = True Then
Startzelle.Offset(intOffset, 0).Value = pvItem.Value
intOffset = intOffset + 1
End If
Next
End If
End If
End Sub

'Code unter dem Tabellenblatt mit dem Pivottabellenbericht einfügen Option Explicit 'Variante 1: Alle Filter in eine Zelle schreiben Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) Call prcPageFieldFilteranzeigen(Target.PageFields("Jahr"), Me.Range("B1")) Call prcPageFieldFilteranzeigen(Target.PageFields("Monat"), Me.Range("B2")) Call prcPageFieldFilteranzeigen(Target.PageFields("Tag"), Me.Range("C2")) End Sub Sub prcPageFieldFilteranzeigen(pvField As PivotField, Startzelle As Range) Dim pvItem As PivotItem 'Alte Einträge löschen Startzelle.ClearContents If pvField.EnableMultiplePageItems = True Then If pvField.LabelRange.Offset(0, 1).Text = "(Mehrere Elemente)" Then For Each pvItem In pvField.PivotItems If pvItem.Visible = True Then If Startzelle = "" Then Startzelle.Value = "'" & pvItem.Value Else Startzelle.Value = "'" & Startzelle.Value & "; " & pvItem.Value End If End If Next End If End If End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Multiselect aus Pivot auslesen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread