AW: Pivot nach aktuellem Feld Filtern
13.08.2010 11:57:37
fcs
Hallo Jens,
da hatte ich meine Beispiel-Pivottabelle wohl etwas zu einfach strukturiert.
Für Reihen und Spaltenfelder sollte es jetzt funktionieren. Es wird jetzt immer erst der Name des Reihen-/Spaltenfeldes ermittelt. Dann erfolgen Aktionen.
Beim Einblenden aller Items könnte noch eine Fehler-Meldung auftreten, deren Nummer ich aber nicht hab.
Makro sollte unter Excel 2003 und 2007 funktionieren.
Gruß
Franz
Sub Test_Filtern_Pivotfeld_Click()
'Inhalt der aktiven Zelle wird als Filter für das entsprechende _
Zeilen- oder Spaltenfeld der Pivottabelle verwendet
On Error GoTo Fehler
Dim iIndex As Integer, vFilter, lZeile As Long, lSpalte As Long
Dim f As PivotField, i As PivotItem, sFieldName As String
Application.ScreenUpdating = False
With ActiveCell.PivotTable
'Filterwert
vFilter = ActiveCell.Text
lZeile = ActiveCell.Row
lSpalte = ActiveCell.Column
If Not Intersect(ActiveCell, .RowRange) Is Nothing _
And lZeile > .RowRange.Row Then
'Pivottabellen-ReihenItem als Filterwert
iIndex = lSpalte - .RowRange.Column + 1
sFieldName = .RowRange(1, iIndex).Text
Set f = .RowFields(sFieldName)
For Each i In f.VisibleItems
If i.Name vFilter Then
i.Visible = False
End If
Next
'Pivottabellen-Spalten-Item als Filterwert
ElseIf Not Intersect(ActiveCell, .ColumnRange) Is Nothing _
And lZeile > .ColumnRange.Row Then
iIndex = lZeile - .ColumnRange.Row
sFieldName = .ColumnRange(1, iIndex).Text
Set f = .ColumnFields(sFieldName)
For Each i In f.VisibleItems
If i.Name vFilter Then
i.Visible = False
End If
Next
Else
MsgBox "Zum Filtern bitte eine Zelle mit Item im " _
& "Reihen- oder Spaltenfeldbereich wählen!"
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles ok
Case 1004
MsgBox "Zum Filtern in Pivottabelle bitte eine Zelle mit Item im " _
& "Reihen- oder Spaltenfeldbereich wählen!"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbNewLine & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub
Sub Test_Pivotfeld_Alle_Anzeigen_Click()
'Alle Items anzeigen in selektierte Zeilen/Spaltenfeld
On Error GoTo Fehler
Dim iIndex As Integer, lZeile As Long, lSpalte As Long
Dim f As PivotField, i As PivotItem, sFieldName As String
Application.ScreenUpdating = False
With ActiveCell.PivotTable
lZeile = ActiveCell.Row
lSpalte = ActiveCell.Column
If Not Intersect(ActiveCell, .RowRange) Is Nothing Then
'Pivottabellen-ReihenItem als Filterwert
iIndex = lSpalte - .RowRange.Column + 1
sFieldName = .RowRange(1, iIndex).Text
Set f = .RowFields(sFieldName)
For Each i In f.HiddenItems
i.Visible = True
Next
'Pivottabellen-Spalten-Item als Filterwert
ElseIf Not Intersect(ActiveCell, .ColumnRange) Is Nothing Then
iIndex = lZeile - .ColumnRange.Row
sFieldName = .ColumnRange(1, iIndex).Text
Set f = .ColumnFields(sFieldName)
For Each i In f.HiddenItems
i.Visible = True
Next
Else
MsgBox "Zum Filtern bitte eine Zelle mit Item im " _
& "Reihen- oder Spaltenfeldbereich wählen!"
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles ok
Case 99999 'Nummer anpassen wenn Fehler kommt
'Pivot-Item in Item List hat keine Daten mehr
Resume Next
Case 1004
MsgBox "Zum Filtern in Pivottabelle bitte eine Zelle mit Item im " _
& "Reihen- oder Spaltenfeldbereich wählen!"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbNewLine & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub