Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Tabelle formatieren und Pivottabelle erstelle

VBA: Tabelle formatieren und Pivottabelle erstelle
14.03.2018 12:52:02
Axel
Hallo zusammen,
in diesem Forum hatte ich bereits hilfreiche Hinweise zu meinem Thema erhalten, aber ich brauche bitte noch einmal Hilfe auf den letzten Metern.
https://www.herber.de/bbs/user/120409.xlsm
Das Makro in der hochgeladenen Datei habe ich schon zum Teil angepasst, wo ich es verstanden habe, aber an einigen Stellen ist das Ergebnis nicht, was ich erwarte:
- Nach Übertrag der Daten aus Tabelle 1 in das neue Tabellenblatt "DatenNeu" sollen die Volumina aus den drei Vol-Spalten im Ziel in einer Spalte untereinander stehen.
- An der Stelle im Makro
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Anzahl von Vol")
.Caption = "Summe von Vol"
.Function = xlSum
End With
habe ich versucht, "Anzahl von Vol" durch "Summe von Vol" zu ersetzen. Das erschien mir logisch, funktioniert aber nicht. Wie ist die korrekte Syntax dafür?
Der Rest passt nach meiner Meinung.
Ich bedanke mich schon einmal vorab für eure Unterstützung.
Beste Grüße
Axel

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

Betreff
Datum
Anwender
Anzeige
AW: VBA: Tabelle formatieren und Pivottabelle erstelle
15.03.2018 09:25:21
Axel
Hallo,
den zweiten Punkt habe ich schon erledigt. Es muss so heißen:
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Vol"), "Summe von Vol", xlSum
Aber was leider immer noch nicht funktioniert ist das Löschen der leeren Zellen und die Anordnung der Werte in einer Spalte untereinander in dem Tabellenblatt "DatenNeu". In der Folge werden die Werte natürlich nicht in der Pivottabelle angezeigt.
Hier das passt noch nicht:
'Alle leeren Zellen in Spalten "Vol1", "Vol2" und "Vol3" löschen _
und Inhalte nach links verschieben
.Range(.Cells(2, 5), .Cells(Zeile, 7)).SpecialCells(xlCellTypeBlanks) _
.Delete Shift:=xlToLeft
Hat jemand eine Idee, wie es richtig lauten muss?
Vielen Dank
Axel
Anzeige
AW: VBA: Tabelle formatieren und Pivottabelle erstelle
16.03.2018 07:27:18
Axel
Hallo zusammen,
leider konnte mir bisher im Forum niemand helfen. Grundsätzlich habe ich aber durchweg positive Erfahrungen mit dem Forum gemacht.
Ich habe die Lösung anderweitig gefunden und poste sie für die, die eventuell vor derselben Aufgabe stehen:
Sub Pivot_erstellen()
Dim wksData As Worksheet
Dim wksNeu As Worksheet
Dim wksAusw As Worksheet
Dim Zeile As Long, Zelle As Range
If MsgBox("Auswertung mit Daten des aktiven Blatts erstellen?", _
vbOKCancel + vbQuestion, "Daten Auswerten") = vbCancel Then Exit Sub
Set wksData = ActiveSheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wksNeu = ActiveWorkbook.Worksheets.Add(after:=wksData)
wksData.Range("A:B").Copy wksNeu.Cells(1, 1)
wksData.Range("E:I").Copy wksNeu.Cells(1, 3)
With wksNeu
.Name = "DatenNeu"
'Leerstrings aus Zellen in Spalten "Vol1", "Vol2" und "Vol3" beseitigen
.Columns("E:G").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
For Zeile = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Range("F" & Zeile).Value  "" Then
If .Range("E" & Zeile).Value = "" Then
.Range("E" & Zeile).Value = .Range("F" & Zeile).Value
Else
''Sollte die Zielzelle widererwarten nicht leer sein
MsgBox "Zelle bereits gefüllt!", vbExclamation, "STOPP"
Stop
End If
End If
If .Range("G" & Zeile).Value  "" Then
If .Range("E" & Zeile).Value = "" Then
.Range("E" & Zeile).Value = .Range("G" & Zeile).Value
Else
''Sollte die Zielzelle widererwarten nicht leer sein
MsgBox "Zelle bereits gefüllt!", vbExclamation, "STOPP"
Stop
End If
End If
Next Zeile
.Columns("F:G").Delete
.Cells(1, 5) = "Vol"
'neues Blatt anlegen für Auswertung per Pivot-Bericht
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)
wksAusw.Name = "Auswertung"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"DatenNeu!R1C1:R1048576C5", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Auswertung!R1C1", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
Sheets("Auswertung").Select
Cells(1, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("NL-Nr.")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Vol"), "Summe von Vol", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Bestimmt gibt es auch andere Lösungen, aber die funktioniert.
Beste Grüße und ein schönes Wochenende
Axel
Anzeige

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige