Per VBA soll eine Kreuztabelle in eine strukturierte Liste gewandelt werden.
Der Code steht auch in der Excel-Tabelle zur Verfügung. Wie der Code funktioniert, kann im unten aufgeführten Video betrachtet werden. Wichtig ist allerdings, dass die erste Datenspalte der Kreuztabelle angeklickt wird, ansonsten findet die Umwandlung nicht korrekt statt.

Die Kreuztabelle wurde bewusst in Spalte B aufgehängt, da ich in Spalte A die Angaben zu den zusätzlichen Überschriften eintrage. Man hätte hier natürlich auch ein neues Register ins Menüband integrieren können.

Option Explicit

Sub KreuztabelleListe()
‘Erstellt von Andreas Thehos, 2014
‘zur Erstellung einer Datenliste ausgehend von kreuztabellierten Daten

Dim wksKreuztabelle As Worksheet ‘Kreuztabelle – Ausgangsdaten
Dim wksZieltabelle As Worksheet ‘Zieltabelle – wird erzeugt
Dim intStartspalte As Integer ‘Spalte der ersten kreuztabellierten DATEN
Dim intAuswertungAntwort As Integer ‘Antwort auf Frage der MsgBox
Dim lngLetzteZeile As Long ‘Letzte Zeile
Dim intLetzteSpalte As Integer ‘Letzte Spalte
Dim j As Long ‘Zähler für Zeilen aus Kreuztabelle
Dim k As Long ‘Zähler für Zeilen in Zieltabelle
Dim i As Integer ‘Zähler für Spalten aus Kreuztabelle
Dim m As Integer ‘Zähler für Spaltenwerte

On Error GoTo ErrorHandler

Application.ScreenUpdating = False ‘Bildschirmaktualisierung aus
Set wksKreuztabelle = ActiveSheet ‘Das aktuelle Blatt wird auf wksKreuztabelle gelegt

‘Ermittlung und Prüfung, wo die Daten der Kreuztabelle beginnen
intStartspalte = ActiveCell.Column

intAuswertungAntwort = MsgBox(“Kreuztabellierte Daten beginnen in Spalte ” & _
intStartspalte – 1 & ” der Kreuztabelle?”, vbInformation + vbYesNo)

Select Case intAuswertungAntwort
Case vbYes
Case vbNo
MsgBox “Markieren Sie bitte die erste Datenzelle der Kreuztabelle und ” & _
“führen Sie das Makro erneut aus.”, vbInformation, “Bitte neu Markieren”
Exit Sub
End Select

‘Ermittlung der letzten Spalte und Zeile der Kreuztabelle
intLetzteSpalte = wksKreuztabelle.Range(“IV1”).End(xlToLeft).Column
lngLetzteZeile = wksKreuztabelle.Range(“B65536”).End(xlUp).Row

Set wksZieltabelle = Sheets.Add(After:=Worksheets(Worksheets.Count))

wksKreuztabelle.Activate
k = 2

‘Hier werden die Daten aber Zeile 2 in die Zieltabelle gesetzt
For i = intStartspalte To intLetzteSpalte
For j = 2 To lngLetzteZeile
If wksKreuztabelle.Cells(j, i).Value “” Then
With wksZieltabelle
For m = 2 To intStartspalte – 1
.Cells(k, m – 1).Value = wksKreuztabelle.Cells(j, m).Value
Next m
‘Hier wird die Überschriftenspalte der Daten in die vorletzte Spalte geschrieben
.Cells(k, intStartspalte – 1).Value = “‘” & wksKreuztabelle.Cells(1, i).Value
‘Hier werden die Daten in die letzte Spalte geschrieben
.Cells(k, intStartspalte).Value = wksKreuztabelle.Cells(j, i).Value
k = k + 1
End With
End If
Next j
Next i

‘Hier werden die Überschriften der Zieltabelle gesetzt
For m = 2 To intStartspalte – 1
wksZieltabelle.Cells(1, m – 1).Value = wksKreuztabelle.Cells(1, m).Value
Next m

‘Es folgen die Überschriften der Daten, die nicht direkt ersichtlich sind
wksZieltabelle.Cells(1, intStartspalte – 1).Value = wksKreuztabelle.Cells(12, 1).Value
wksZieltabelle.Cells(1, intStartspalte).Value = wksKreuztabelle.Cells(15, 1).Value

Set wksZieltabelle = Nothing
Set wksKreuztabelle = Nothing

Application.ScreenUpdating = True
Exit Sub

‘Im Falle des Fehlerfalles
ErrorHandler:
MsgBox “Ein Fehler ist aufgetreten.”
Application.ScreenUpdating = True
End Sub

Hier ist die XLSM-Datei zur Umwandlung einer Kreuztabelle in eine strukturierte Liste:
Kreuztabellierte_Daten

Hier ist das Video:
Videolink: http://youtu.be/1H-L80AJflU