Excel – Kreuztabelle per VBA in Liste umwandeln

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

5 Kommentare

  1. Christian

    Ich glaube in dem Skript ist noch ein Fehler. Bei mir gab es einen Syntaxfehler und ich habe folgende Änderung vorgenommen:
    —————————-
    ‚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
    ———————————–

    Es fehlte das Ungleichheitszeichen.

    • thehosblog

      Danke für den Hinweis, wurde als HTML-Tag interpretiert und vom System nicht erkannt und deshalb entfernt.

  2. cmatyas

    ‚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

    ———————
    Ich habe in meinem Skript das Ungleichheitszeichen hinzufügen müssen damit ich keinen Syntaxfehler bekomme.

    • thehosblog

      Das Ungleichzeichen wurde mir vermutlich als HTML-Tag interpretiert und von WordPress rausgelöscht. Danke für den Hinweis.

      • cmatyas

        Oh stimmt die gute alte HTML Falle, da drehte ich auch öfters mal rein. Das Script hat mir auf jeden Fall viel Arbeit erspart, danke dir!

Kommentar verfassen

Trage deine Daten unten ein oder klicke ein Icon um dich einzuloggen:

WordPress.com-Logo

Du kommentierst mit Deinem WordPress.com-Konto. Abmelden / Ändern )

Twitter-Bild

Du kommentierst mit Deinem Twitter-Konto. Abmelden / Ändern )

Facebook-Foto

Du kommentierst mit Deinem Facebook-Konto. Abmelden / Ändern )

Google+ Foto

Du kommentierst mit Deinem Google+-Konto. Abmelden / Ändern )

Verbinde mit %s