AW: Tabelle transponieren für Pivot
14.04.2015 15:16:16
fcs
Hallo Berni,
das Umstellen der Daten per Formel ist mühselig und erfordert nach meiner Einschätzung mindestens 1 Hilfsspalte, damit die Formeln nicht zu unübersichtlich werden.
HS PSP-Element______ Arbeitsaufträge IST Monat Plan
0 1E.00196.010.01.010 220700000 10.041
Formeln:
A2: =WENN(ZEILE()-10;BEREICH.VERSCHIEBEN(Tabelle1!$D$2;0;A2-1);"")
F2: =WENN(A2>0;INDEX(BEREICH.VERSCHIEBEN(Tabelle1!$D$3:$D$17;0;A2-1);
ZEILE()-$A2*ZEILEN(Tabelle1!E$3:E$17)-1;1);"")
Ich persönlich würde hier die Umgruppierung per Makro vorziehen.
Gruß
Franz
'Code in einem allgemeinen Modul - z.B. der persönlichen Makroarbeitsmappe
Sub Umgruppieren()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim Zeile_T As Long, Zeile_L As Long, Spalte_Q As Long
Dim Zeile_Z As Long, Zeile_Z1 As Long
Dim rngZeilenT As Range, rngMonat As Range, rngPlan As Range
Dim SpaMo As Long, SpaPlan As Long
'Ursprungstabelle setzen
Set wksQ = ActiveSheet
'Zeile mit Spaltentiteln/Monaten in Quelltabelle
Zeile_T = 2
'Neues Blatt für umgruppierte Tabelle anlegen
ActiveWorkbook.Worksheets.Add after:=wksQ
Set wksZ = ActiveSheet
'Zeile mit Spaltentiteln in umgruppierter Tabelle
Zeile_Z1 = 1
SpaMo = 4 'Spalte D
SpaPlan = 5 'Spalte E
'Tabelle unterhalb Titelzeile einfrieren
wksZ.Cells(Zeile_Z1 + 1, 1).Select
ActiveWindow.FreezePanes = True
Zeile_Z = Zeile_Z1
With wksQ
'letzte Zeile mit Daten in Spalte A in Quelltabelle
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'Spaltentitel in Spalten A:C nach Ziel kopieren
.Range(.Cells(Zeile_T, 1), .Cells(Zeile_T, 3)).Copy
With wksZ.Cells(Zeile_Z, 1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteAll
End With
'Spaltentitel für neue Spalten
wksZ.Cells(Zeile_Z, SpaMo) = "Monat"
wksZ.Cells(Zeile_Z, SpaPlan) = "Plan"
Zeile_Z = Zeile_Z + 1
'Datenbereich mit Zeilentiteln, die für jeden Monat kopiert werden sollen
Set rngZeilenT = .Range(.Cells(Zeile_T + 1, 1), .Cells(Zeile_L, 2))
'Daten in Spalten A:C nach Ziel kopieren (IST-Daten)
'.Range(.Cells(Zeile_T + 1, 1), .Cells(Zeile_L, 3)).Copy wksZ.Cells(Zeile_Z, 1)
'Einfügezeile für Daten des 1. Monats in Zieltabelle
'Zeile_Z = Zeile_Z + rngZeilenT.Rows.Count
'Monate in Quelle abarbeiten
For Spalte_Q = 4 To .Cells(Zeile_T, .Columns.Count).End(xlToLeft).Column
'Zelle mit Monat
Set rngMonat = .Cells(Zeile_T, Spalte_Q)
'Zellbereich mit Planwerten für Monat
Set rngPlan = .Range(.Cells(Zeile_T + 1, Spalte_Q), .Cells(Zeile_L, Spalte_Q))
'Monats-Plan-Daten kopieren
With wksZ
rngZeilenT.Copy .Cells(Zeile_Z, 1)
rngMonat.Copy .Range(.Cells(Zeile_Z, SpaMo), _
.Cells(Zeile_Z + rngZeilenT.Rows.Count - 1, SpaMo))
rngPlan.Copy .Cells(Zeile_Z, SpaPlan)
End With
'Einfügezeile für Folgemonat
Zeile_Z = Zeile_Z + rngZeilenT.Rows.Count
Next
'letzte Datenzeile in Zieltabelle
Zeile_Z = Zeile_Z - 1
End With
'Zieltabelle nachformatieren
With wksZ
With .Range(.Columns(SpaMo), .Columns(SpaPlan))
.AutoFit
End With
With .Range(.Cells(Zeile_Z1, 1), .Cells(Zeile_Z, SpaPlan))
.Interior.ColorIndex = xlColorIndexNone
.Borders.LineStyle = xlLineStyleNone
End With
End With
End Sub