AW: Pivot "Other" Kategorie zu Top10 Filter
26.09.2014 16:36:12
fcs
Hallo Sioo,
mit den Standard-Einstellungen von Excel für Pivotberichte geht da meines Wissens nichts.
Man kann das Gruppieren per Makro automatisieren. Das erfordert dann aber eine bezüglich Tabellen- und Feldnamen maßgeschneiderte Makro-Version.
Nachfolgend ein entsprechendes Makro, das du ggf. an deine Bedingungen anpassen kannst.
Gruß
Franz
'Code in einem allgemeinen VBA-Modul
Sub PivotTop10GroupOther()
' Ermittelt die Top 10 der Pivotauswertung und gruppiert die restlichen zu Other
Dim wks As Worksheet
Dim pvTab As PivotTable, pvField As PivotField, strField As String
Dim Zelle As Range, rngOther As Range
Dim arrTop10() As String, iTop10 As Integer
Dim intFehler As Integer, strMsg As String
On Error GoTo Fehler
strField = "Markt" 'Name des Feldes, das ggf. zu Top10 und "Other" gruppiert wird
intFehler = 1
Set wks = ActiveWorkbook.Worksheets("Pivot01") 'Name ggf. anpassen!!
wks.Activate
intFehler = 2
Set pvTab = wks.PivotTables(1)
pvTab.RefreshTable
'ggf. vorhandene Gruppierung im Feld auflösen
intFehler = 3
Set pvField = pvTab.PivotFields(strField & "2") 'Name des gruppierten Feldes
If Not pvField Is Nothing Then
wks.Columns.Hidden = False
pvField.LabelRange.Select
Selection.Ungroup
End If
ResumeNotGrouped:
intFehler = 4
Set pvField = pvTab.PivotFields(strField)
pvField.ClearAllFilters
' 'Top10-Filter setzen
intFehler = 5
pvField.PivotFilters.Add Type:=xlTopCount, DataField:= _
pvTab.PivotFields("Summe von Umsatz"), Value1:=10 '"Umsatz" ggf. anpassen
'Top 10 - Werte in Array speichern
ReDim arrTop10(1 To pvField.DataRange.Rows.Count)
iTop10 = 0
For Each Zelle In pvField.DataRange
iTop10 = iTop10 + 1
arrTop10(iTop10) = Zelle.Text
Next
'Filter wieder zurücksetzen
pvField.ClearAllFilters
'Zellen mit Label außerhalb Top 10 in Range-Objekt sammeln
For Each Zelle In pvField.DataRange
For iTop10 = 1 To UBound(arrTop10)
If arrTop10(iTop10) = Zelle.Text Then
Exit For
End If
Next
If iTop10 > UBound(arrTop10) Then
If rngOther Is Nothing Then
Set rngOther = Zelle
Else
Set rngOther = Application.Union(rngOther, Zelle)
End If
End If
Next
If rngOther Is Nothing Then
'alle Items in Top 10
Else
'Other-Items gruppieren
rngOther.Select
Selection.Group
intFehler = 6
'Gruppe umbenennen und Details ausbenden
pvTab.PivotFields(strField & "2").PivotItems("Gruppe1").Caption = "Other"
pvTab.PivotFields(strField & "2").PivotItems("Other").ShowDetail = False
'Zeilen nach Gesamtergebnis sortieren
' pvTab.PivotFields(strField & "2").AutoSort xlDescending, "Summe von Umsatz"
'Spalte mit Feldname ausblenden
pvField.LabelRange.EntireColumn.Hidden = True
End If
Fehler:
With Err
strMsg = "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf
Select Case .Number
Case 0
Case 1004
Select Case intFehler
Case 1
MsgBox strMsg & "Im Code den Namen des Blattes mit dem Pivotbericht anpassen!!"
Case 2
MsgBox strMsg & "Kein Pivotbericht auf Blatt """ & wks.Name & """!!"
Case 3
Resume ResumeNotGrouped
Case 4
MsgBox strMsg & "Im Code den Namen des Pivotfeldes anpassen!!"
Case 5
MsgBox strMsg & "Im Code den Namen des Summenfeldes anpassen!!"
Case 6
MsgBox strMsg & "Im Code den Namen des Gruppenfeldes anpassen!!"
Case Else
MsgBox strMsg & "Wert von intFehler: " & intFehler
End Select
Case Else
MsgBox strMsg & "Wert von intFehler: " & intFehler
End Select
End With
Erase arrTop10
Set rngOther = Nothing: Set pvField = Nothing: Set pvTab = Nothing: Set wks = Nothing
End Sub
Sub PivotUngroupMarkt2()
'Gruppierung für gruppiertes Feld aufheben
Dim strField As String
strField = "Markt"
On Error GoTo Fehler
With ActiveWorkbook.Worksheets("Pivot01")
.Activate
.Columns.Hidden = False
.PivotTables(1).PivotFields(strField & "2").LabelRange.Select
Selection.Ungroup
End With
Fehler:
End Sub