Pivot erstellen mit VBA
02.07.2021 11:26:07
Marco
ich habe aus dem Forum eine Formel gefunden um eine Pivot Tabelle zu erstellen in VBA, was soweit auch funktioniert, außer das mir die Summe Werte nicht in Spalten angezeigt werden, sondern in Zeilen. Finde aber nicht den Punkt, wo ich das verändern muss.
Kann mir hier jemand ggfs. auf die Sprünge helfen. Ein Beispiel füge ich an mit einem Auszug Testdaten und einmal wie das Pivot aus VBA erstellt wird und wie es sein soll.
Beispieldatei. : https://www.herber.de/bbs/user/146912.xlsx
Sub CreatePivot()
'Variablen für PivotTable und PivotField zuordnen
Dim objTable As PivotTable, objField As PivotField
'Das Sheet mit den Daten und der ersten Zelle angeben --> im Beispiel A1
ActiveWorkbook.Sheets("100003 06.2021").Select
Range("A1").Select
'Auf Basis der Daten in Sheet "Alle Monate" eine Pivot Tabelle erstellen
Set objTable = ActiveWorkbook.Sheets("100003 06.2021").PivotTableWizard
'Pivotnamen auslesen und ändern
With ActiveSheet
If .PivotTables.Count Then
.PivotTables(1).Name = "Test_Pivot"
End If
End With
'Innerhalb der Pivot Spaltenbeschriftung und Zeilenbeschriftung angeben
'xlRowField = Zeilenbeschriftung
'xlColumnField = Spaltenbeschriftung
Set objField = objTable.PivotFields("KONZERN")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Name 1")
objField.Orientation = xlRowField
'Werte innerhalb der Pivot-Tabelle festlegen
Set objField = objTable.PivotFields("AJ_MON_VK")
objField.Orientation = xlDataField
objField.Function = xlSum
Set objField = objTable.PivotFields("AJ_MON_ER")
objField.Orientation = xlDataField
objField.Function = xlSum
Set objField = objTable.PivotFields("AJ_AUF_VK")
objField.Orientation = xlDataField
objField.Function = xlSum
Set objField = objTable.PivotFields("AJ_AUF_ER")
objField.Orientation = xlDataField
objField.Function = xlSum
'Teilergebnisse aus der Tabelle entfernen
ActiveSheet.PivotTables("Test_Pivot").PivotFields("KONZERN").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
'Spaltenbreite automatisch anpassen
ActiveSheet.Columns("A:ZZ").EntireColumn.AutoFit
End Sub