folgende Problematik beschäftigt mich aktuell.
Ich muss regelmäßig Datenexports für Pivot-Auswertungen aufbereiten. Meistens stehen in den ersten Spalten des Exports Texte (z.B. Projekt-ID, Projektname, Projektstatus etc.) und in den darauffolgenden Spalten Zahlen (z.B. pro Monate, pro Quartal etc.)
Für die Pivot-Auswertung sollen nun die Überschriften der Zahlenspalten sowie die Zahlen aus den Zahlenspalten selbst jeweils in einer eigenen Spalte untereinander stehen, damit diese besser für eine Pivot-Auswertung verwendet werden können.
Hier eine Arbeitsmappe als Beispiel wie die Daten aktuell aussehen und wie das Zielbild sein soll. Die Anzahl der Text- und Zahlenspalten variiert allerdings bei meinen Export. https://www.herber.de/bbs/user/123268.xlsx
Da die Exports 1.000+ Zeilen haben ist ein manuelles umgruppieren der Daten viel zu aufwendig und ich würde dies gerne mit VBA lösen.
In einem alten Forumsbeitrag: https://www.herber.de/forum/archiv/1356to1360/1357613_Pivot_Tabelle_12_Monate_in_Zeilen_drehen.html
habe ich auch schon eine fast passende Lösung gefunden, allerdings ist der VBA Code für 4 Textspalten und 12 Zahlenspalten geschrieben worden. Da ich VBA-Anfänger bin, weiß ich nun leider nicht an welchen Stellen ich den Code wie anpassen muss, damit er mit meiner jeweiligen Datentabelle (Export) funktioniert.
Kann mir bitte jemand weiterhelfen und sagen, an welche Stelle im Code ich die Parameter für die Anzahl der Textspalten und die Anzahl an Zahlenspalten anpassen muss.
Vielen Dank im Voraus.
Gruß Sebi
Aktueller VBA Code:
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