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