Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Pivot "Other" Kategorie zu Top10 Filter

Betrifft: Pivot "Other" Kategorie zu Top10 Filter von: Sioo
Geschrieben am: 26.09.2014 11:58:52

Hallo zusammen,

habe eine Pivot wo ich mir die Top10 Märkte anschaue. Das mach ich indem ich den Top10 Filter nutze. Ich möchte aber zusätzlich eine Kategorie die mir den Rest der Werte als "Other" ausgibt.

Habe es bisher so gelöst:
2. Pivot Tabelle, Top 10 Märkte ausgrenzen und Gruppieren - umbennen

Die Lösung finde ich aber nicht so super. Gibt es eine Möglichkeit alles in einer Tabelle zu haben?

  

Betrifft: AW: Pivot "Other" Kategorie zu Top10 Filter von: fcs
Geschrieben am: 26.09.2014 16:36:12

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



  

Betrifft: AW: Pivot "Other" Kategorie zu Top10 Filter von: Sioo
Geschrieben am: 26.09.2014 17:03:07

uff, das sieht kompliziert aus. Danke erstmal für deine Mühe. Ich schau mir das mal an. Habe sicherherleich weitere Fragen dazu


  

Betrifft: AW: Pivot "Other" Kategorie zu Top10 Filter von: Hajo_Zi
Geschrieben am: 27.09.2014 10:04:57

stelle mit weiteren Fragen den Beitrag auf offen, jetzt ist ja nichts offen.

Gruß Hajo


 

Beiträge aus den Excel-Beispielen zum Thema "Pivot "Other" Kategorie zu Top10 Filter"