Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1776to1780
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pivot Tabelle via Makros

Pivot Tabelle via Makros
31.08.2020 13:01:59
Niklas
Hallo zusammen,
ich würde gerne eine Pivot Tabelle mittels eines Makros erstellen lassen.
Über den Makrorecorder habe ich folgenden Code ausgeworfen bekommen:
Sub Makro2()
' Makro2 Makro
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"1. Auswertung!R3C1:R65C6", Version:=6).CreatePivotTable TableDestination:= _
"1. Auswertung Pivot!R1C1", TableName:="PivotTable4", DefaultVersion:=6
Sheets("1. Auswertung Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber #")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber Name")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber #").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False,  _
False _
)
ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber #"). _
LayoutForm = xlTabular
ActiveWindow.SmallScroll Down:=9
ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False,  _
_
False, False)
ActiveSheet.PivotTables("PivotTable4").PivotFields("Auftraggeber Name"). _
LayoutForm = xlTabular
ActiveWindow.SmallScroll Down:=-39
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Summe EUR"), "Summe von Summe EUR", xlSum
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Summe von 2018, Stck")
.Orientation = xlRowField
.Position = 3
End With
ActiveWindow.SmallScroll Down:=33
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
Damit ich diesen Code komplett variabel gestalte, habe ich ein paar Kleinigkeiten daran verändert, sodass ich diese Tabelle sich variabel erstellen lassen kann. Der Code dazu sieht wie folgt aus:
Dim Zeilenanzahl4 As Integer
Zeilenanzahl4 = Sheets(Eingabe2 & ". Auswertung").Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Eingabe2 & ". Auswertung!R3C1:R" & Zeilenanzahl4 & "C6", Version:=6).CreatePivotTable TableDestination:= _
Eingabe2 & ". Auswertung Pivot!R3C1", TableName:="PivotTable" & Eingabe2 + 2, DefaultVersion:=6
Sheets(Eingabe2 & ". Auswertung Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber #")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber Name")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber Name"). _
LayoutForm = xlTabular
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber #").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).PivotFields("Auftraggeber #"). _
LayoutForm = xlTabular
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).AddDataField ActiveSheet.PivotTables( _
"PivotTable" & Eingabe2 + 2).PivotFields("Summe EUR"), _
"Summe von Summe EUR", xlSum
ActiveSheet.PivotTables("PivotTable" & Eingabe2 + 2).AddDataField ActiveSheet.PivotTables( _
"PivotTable" & Eingabe2 + 2).PivotFields("Summe Stck"), _
"Summe von Summe Stck", xlSum
Jedoch funktioniert das Ganze leider nicht.
Zur Erläuterung: Eingabe2 ist lediglich eine Inputbox, in welcher irgendwelche Zahlen eingetragen werden.
Kann mir jemand vielleicht bei der Problematik helfen?

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivot Tabelle via Makros
31.08.2020 17:29:09
fcs
Hallo Niklas,
hier die gewünschte Unterstützung
Durch die Verwendung von Objektvariablen für die Tabellen und den Pivot-Bericht wird es etwas übersichtlicher.
Ich hab auch ein paar Prüfungen eingebaut (Blattnamen, Pivotbericht) damit es nicht zu Fehlern im Makroablauf kommt.
LG
Franz
Sub Test2()
'Erstellen Pivot-Tabelelnbericht
Dim Zeilenanzahl4 As Integer
Dim wksData As Worksheet, wksPivot As Worksheet
Dim wkb As Workbook
Dim pvTab As PivotTable
Dim Eingabe2
On Error GoTo Fehler
Eingabe2 = Application.InputBox("Zählnummer Blatt", "Pivotbericht erstellen", 1, Type:=1)
If Eingabe2 = False Then Exit Sub
Set wkb = ActiveWorkbook
'Prüfen der Blattnamen
If fncCheckSheetName(Eingabe2 & ". Auswertung", wkb) = False Then
MsgBox "Blatt """ & Eingabe2 & ". Auswertung" & """ ist nicht vorhanden!", _
vbOKOnly, "Erstellen Pivotbericht"
Exit Sub
End If
If fncCheckSheetName(Eingabe2 & ". Auswertung Pivot", wkb) = False Then
MsgBox "Blatt """ & Eingabe2 & ". Auswertung Pivot" & """ ist nicht vorhanden!", _
vbOKOnly, "Erstellen Pivotbericht"
Exit Sub
End If
Set wksData = wkb.Worksheets(Eingabe2 & ". Auswertung")
Set wksPivot = wkb.Worksheets(Eingabe2 & ". Auswertung Pivot")
'Prüfen, ob Pivottabellenbericht schon vorhanden
If wksPivot.PivotTables.Count > 0 Then
MsgBox "Im Blatt """ & wksPivot.Name & """ existiert schon ein Pivottabellenbericht!", _
vbOKOnly, "makro. Test2"
Exit Sub
End If
With wksData
Zeilenanzahl4 = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Set pvTab = wkb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"'" & wksData.Name & "'!R3C1:R" & Zeilenanzahl4 & "C6", Version:=6).CreatePivotTable _
(TableDestination:="'" & wksPivot.Name & "'!R3C1", _
TableName:="PivotTable" & Eingabe2 + 2, DefaultVersion:=6)
wksPivot.Select
With pvTab
With .PivotFields("Auftraggeber #")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Auftraggeber Name")
.Orientation = xlRowField
.Position = 2
End With
.PivotFields("Auftraggeber Name").Subtotals = Array(False, False, False, False, _
False, False, False, False, False, False, False, False)
.PivotFields("Auftraggeber #").Subtotals = Array(False, False, False, False, _
False, False, False, False, False, False, False, False)
.AddDataField .PivotFields("Summe EUR"), "Summe von Summe EUR", xlSum
.AddDataField .PivotFields("Summe Stck"), "Summe von Summe Stck", xlSum
.RowAxisLayout xlTabularRow
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbOKOnly, "makro: Test 2"
End Select
End With
End Sub
Public Function fncCheckSheetName(sName As String, Optional wkb As Workbook) As Boolean
Dim objSheet
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
Set objSheet = wkb.Sheets(sName)
fncCheckSheetName = True
Fehler:
End Function

Anzeige
AW: Pivot Tabelle via Makros
01.09.2020 07:27:52
Niklas
Hallo Franz,
das funktioniert genauso wie ich mir das vorgestellt habe.
Vielen vielen Dank, allein wäre ich vermutlich nie darauf gekommen!
Liebe Grüße
Niklas

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige