AW: Pivot Tabelle 12 Monate in Zeilen drehen
19.04.2014 08:19:27
fcs
Hallo Werner,
du musst in meinem Makro noch eine Anweisung zum Sortieren einfügen, um die Daten in die gewünschte Reihenfolge zu bringen.
Gruß
Franz
Sub Daten_Umgruppieren()
' Daten_Umgruppieren für Pivot-Auswertung
Dim wks As Worksheet, ZeileTitel As Long, Zeile As Long
Dim Spalte As Long, SpalteMonat As Long, SpalteWerte As Long
Dim Zeile1 As Long, Zeile2 As Long, rngA_D As Range
ZeileTitel = 1 'ggf. anpassen!
SpalteMonat = 17 'Zielspalte für Monatsnamen
SpalteWerte = 18 'Zielspalte für Werte zu Monaten
Set wks = ActiveSheet
'Blatt mit Ausgangsdaten kopieren
wks.Copy After:=wks
Set wks = ActiveSheet
wks.Name = "PivotData"
Application.ScreenUpdating = False
With wks
Zeile1 = ZeileTitel + 1
Zeile2 = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA_D = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 4))
.Cells(ZeileTitel, SpalteMonat).Value = "Monat"
.Cells(ZeileTitel, SpalteWerte).Value = "Wert"
For Spalte = 5 To 16 'Spalten E bis P mit Werten zu den Monaten
'Zielzeile für Daten zu Monat
Zeile = Zeile1 + (Spalte - 5) * rngA_D.Rows.Count
'Datenblock in Spalten A bis D kopieren
rngA_D.Copy Destination:=.Cells(Zeile, 1)
'Werte zum Monat verschieben in neue Wertespalte
.Range(.Cells(Zeile1, Spalte), .Cells(Zeile2, Spalte)).Cut _
Destination:=.Cells(Zeile, SpalteWerte)
'Monatsname in Titelzeile kopieren in neue Monatsspalte
.Cells(ZeileTitel, Spalte).Copy _
Destination:=.Range(.Cells(Zeile, SpalteMonat), _
.Cells(Zeile + rngA_D.Rows.Count - 1, SpalteMonat))
Next
.Range(.Columns(SpalteMonat), .Columns(SpalteWerte)).EntireColumn.AutoFit
'alte Monatsspalten löschen
.Range(.Columns(5), .Columns(16)).Delete shift:=xlShiftToLeft
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:= _
.Cells(ZeileTitel, 1), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:= _
.Cells(ZeileTitel, 2), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:= _
.Cells(ZeileTitel, 3), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:= _
.Cells(ZeileTitel, 4), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:= _
.Cells(ZeileTitel, 5), SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:="Jan,Feb,Mrz,Apr,Mai,Jun,Jul,Aug,Sep,Okt,Nov,Dez", _
DataOption:=xlSortNormal
With .Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.SetRange wks.Range(wks.Cells(ZeileTitel, 1), wks.Cells(Zeile + rngA_D.Rows.Count - 1, _
6))
.Apply
End With
End With
Application.ScreenUpdating = True
End Sub