AW: Pivot-Gruppierung: nur Teil anzeigen
03.06.2009 14:33:33
fcs
Hallo Florian,
der entsprechende Code sollte inklusive Eingabe von Start und Ende-Datum wie folgt aussehen.
Im Anschluß noch die von mir getestete Prozedur mit einem Feld Namens "Datum" in der Datenquelle.
Gruß
Franz
Sub Stat_gruppierung()
Dim PT As PivotTable, PTCache As PivotCache
Dim DatenDatei As Workbook, DatenSheet As Worksheet, StatTilSheet As Worksheet
Dim pvField As PivotField
Dim datStart As Date, datEnde As Date
Dim LastRowDaten As Long
Set DatenDatei = ThisWorkbook
Set DatenSheet = DatenDatei.Sheets("Daten")
' Add StatTilSheet
Set StatTilSheet = DatenDatei.Worksheets.Add
ActiveSheet.Name = "StatTil"
LastRowDaten = DatenSheet.Cells(Rows.Count, 1).End(xlUp).Row - _
Not IsEmpty(DatenSheet.Cells(Rows.Count, 1).End(xlUp)) - 1
Set PTCache = DatenDatei.PivotCaches.Add _
(SourceType:=xlDatabase, SourceData:=DatenSheet.Range(DatenSheet.Cells(3, 1), _
DatenSheet.Cells(LastRowDaten, 73)))
Set PT = PTCache.CreatePivotTable _
(tabledestination:=StatTilSheet.Cells(6, 2), tablename:="Pivottable1")
With PT
.PivotFields(13).Orientation = xlPageField
.PivotFields(30).Orientation = xlRowField 'Datum
.PivotFields(19).Orientation = xlColumnField
.PivotFields(1).Orientation = xlDataField
.PivotFields("Sum av OrdNr").Function = xlCount
Set pvField = .PivotFields(30) 'Datum
End With
'Startdatum eingeben
datStart = Application.InputBox(Prompt:="Stardatum für Pivotbericht", _
Title:="Pivottabelle gruppieren", _
Default:=Format(Date, "MM.DD.YYYY"), _
Type:=1)
If datStart = 0 Then Exit Sub 'Abbrechen in Eingabe
'Endedatum eingeben
datEnde = Application.InputBox(Prompt:="Stardatum für Pivotbericht", _
Title:="Pivottabelle gruppieren", _
Default:=Format(Date, "MM.DD.YYYY"), _
Type:=1)
If datEnde = 0 Then Exit Sub 'Abbrechen in Eingabe
'Gruppieren Datum nach Jahren und Monaten
With pvField
.LabelRange.Group Start:=datStart, End:=datEnde, Periods:=Array(False, False, False _
, False, True, False, True)
End With
'Kleinere und größere Datums-Werte ausblenden
With PT.PivotFields("Jahre")
.PivotItems("" & datEnde).Visible = False
End With
End Sub
'getestetes Beispiel
Sub Makro1()
' Erstellt unter Excel 2003
'Gruppieren des Feldes "Datum" in Pivottabelle mit Start- und Enddatum
Dim pvTab As PivotTable
Dim pvField As PivotField
Dim datStart As Date, datEnde As Date
Set pvTab = Worksheets("Tabelle1").PivotTables(1)
Set pvField = pvTab.PivotFields("Datum")
datStart = Application.InputBox(Prompt:="Stardatum für Pivotbericht", _
Title:="Pivottabelle gruppieren", _
Default:=Format(Date, "MM.DD.YYYY"), _
Type:=1)
If datStart = 0 Then Exit Sub 'Abbrechen in Eingabe
datEnde = Application.InputBox(Prompt:="Stardatum für Pivotbericht", _
Title:="Pivottabelle gruppieren", _
Default:=Format(Date, "MM.DD.YYYY"), _
Type:=1)
If datEnde = 0 Then Exit Sub 'Abbrechen in Eingabe
'Gruppieren nach Jahren und Monaten
With pvField
.LabelRange.Group Start:=datStart, End:=datEnde, Periods:=Array(False, False, False _
, False, True, False, True)
End With
'Kleinere und größere Datums-Werte ausblenden
With pvTab.PivotFields("Jahre")
.PivotItems("" & datEnde).Visible = False
End With
End Sub