Microsoft Excel

Herbers Excel/VBA-Archiv

Pivot-Tabelle Berichtsseiten

Betrifft: Pivot-Tabelle Berichtsseiten von: Martin
Geschrieben am: 30.10.2014 11:14:48

Liebe Kollegen,

über Berichtsfiltersseiten anzeigen kann ich für jeden Filter ein extra Blatt erstellen - so weit so gut - jetzt habe ich aber auch auf der Seite ein Chart - und möchte das aktualisiert auf jeder erstellten Seite auch haben. Hat jemand einen Skript oder eine Funktiom, um das zu machen.

Danke.
Martin

  

Betrifft: AW: Pivot-Tabelle Berichtsseiten von: fcs
Geschrieben am: 30.10.2014 12:05:44

Hallo Martin,

wenn man Pivot-Tabelle und eingbettetes Diagramm für jeden Filterwert eines Berichtsfeldes kopieren möchte, dann muss man jeweils das komplette Sheet/Tabellenblatt kopieren.

Namchfolgend ein entsprechendes Makro in dem du Blatt und Feldnamen noch anpassen mus.

Gruß
Franz

'Erstellt unter Excel 2010
Sub Pivots_mit_Diagramm_Berichtsfelder()
  'Tabellenblatt mit Pivottabelle und Diagramm für jeden Filterwert kopieren _
      und Filter setzen
  Dim wksPivot As Worksheet, wksAktiv As Worksheet
  Dim strBerichtsfeld As String
  Dim pvTab As PivotTable, pvField As PivotField, pvItem As PivotItem
  Dim intItem As Integer, arrItems() As String
  
  'Tabellenblatt mit Original-Pivotbericht und -Diagramm
  Set wksPivot = ActiveWorkbook.Worksheets("Auswertung") 'Name ggf. anpassen
  Set pvTab = wksPivot.PivotTables(1)
  
  strBerichtsfeld = "Kunde"       'Name des Berichtsfeldes - ggf. anpassen
  Set pvField = pvTab.PageFields(strBerichtsfeld)
  
  'Filter für Feld zurücksetzen und alle Filterwerte/Items in Array einlesen
  pvField.ClearAllFilters
  ReDim arrItems(1 To pvField.PivotItems.Count)
  'Alle Pivotitems in Array einlesen
  For Each pvItem In pvField.PivotItems
      intItem = intItem + 1
      ReDim Preserve arrItems(1 To intItem)
      arrItems(intItem) = pvItem.Name
  Next
  
  'Auswertungsblatt mit Pivot/Diagramm für jeden Filterwert des Berichtsfeldes _
      kopieren und Filterwert setzen
  For intItem = 1 To UBound(arrItems)
    Select Case arrItems(intItem)
      Case "(All)", "(Alle)"
        'do nothing
      Case Else
        wksPivot.Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Set wksAktiv = ActiveSheet
        'Blattname anpassen
        wksAktiv.Name = Left(Format(intItem, "00") & "-" & arrItems(intItem), 32)
        Set pvTab = wksAktiv.PivotTables(1)
        Set pvField = pvTab.PageFields(strBerichtsfeld)
        pvField.CurrentPage = arrItems(intItem)
        pvTab.RefreshTable 'evtl. nicht notwendig
    End Select
    If intItem = 3 Then Exit For 'Notausgang zum Testen - Zeile löschen wenn alles funktioniert
  Next
End Sub




  

Betrifft: AW: Pivot-Tabelle Berichtsseiten von: Martin
Geschrieben am: 30.10.2014 12:57:55

sensationell - bitte an Microsoft weitergeben;-) - die sollten das mal als Häkchen (mit Pivotchart) aufnehmen.

Danke!