Office: Unformattierte Pivot-Tabelle auflösen

Guten Morgen Forum,

ich habe eine kurze Frage:

Ich habe in Excel 2010 eine Tabelle. Diese Tabelle enthält Daten, die durch Zeilen- und Spalten-Überschriften sortiert sind. Ich nehme an, dass diese Tabelle einmal eine Pivot-Tabelle war, deren Pivot-Formattierung gelöscht worden ist. Ich habe nun nur Zellen mit einfachen Zahlen, die durch Rahmen voneinander getrennt sind.

Gibt es eine Möglichkeit, die "Grunddaten", so wie diese vor der Formattierung als Pivot-Tabelle zur Verfügung gestanden haben, irgendwie herzustellen? D.h. Ich erzeuge für jedes Element der Spaltenüberschriften neue Zeilen, so dass das Dokument nur noch Zeilenüberschriften enthält. Die Spaltenüberschriften sind jetzt als eigene Elemente in die Zeilen integriert.

Ich habe euch einen Auszug aus der Tabelle mit Beispiel für mein gewünschtes Ergebnis angehängt. Die originale Tabelle enthält noch deutlich mehr Elemente.

Grüße und danke für die Hilfe!
Luk-#+

 

Hallo!

Mit Formeln dürfte das äußerst kompliziert werden (bei großen Datenmengen auch seeehr langsam), aber mit VBA ist (zumindest) dein Beispiel recht schnell zu erschlagen:

Code:

Sub PivotZurueck()

    Dim ErsteZ As Long, LetzteZ As Long, ErsteS As Long, LetzteS As Long
    Dim Zeile As Long, Spalte As Long
    Dim ZeileNeu As Long, SpalteNeu As Long, x As Long

    ErsteZ = 5      '  Erste Zeile deines Quellbereichs
    LetzteZ = 7     ' Letzte Zeile deines Quellbereichs
    ErsteS = 5      ' Erste Spalte deines Quellbereichs
    LetzteS = 18    'Letzte Spalte deines Quellbereichs
    ZeileNeu = 14   '  Erste Zeile deines Ausgabebereichs
    SpalteNeu = 1   ' Erste Spalte deines Ausgabebereichs

    For Zeile = ErsteZ To LetzteZ
        For Spalte = ErsteS To LetzteS
            If Not IsEmpty(Cells(Zeile, Spalte)) Then
                Cells(ZeileNeu, SpalteNeu) = Cells(Zeile, 1)
                x = Spalte
                Do Until Not IsEmpty(Cells(3, x))
                    x = x - 1
                Loop
                Cells(ZeileNeu, SpalteNeu + 1) = Cells(3, x)
                Cells(ZeileNeu, SpalteNeu + 2) = Cells(4, Spalte)
                Cells(ZeileNeu, SpalteNeu + 3) = Cells(Zeile, Spalte)
                ZeileNeu = ZeileNeu + 1
            End If
        Next Spalte
    Next Zeile
    
End Sub