Excel – Kreuztabelle in normale Liste umwandeln

Was würdet Ihr machen, wenn Ihr eine Kreuztabelle erhaltet und diese vernünftig mit Pivot auswerten müsst?
In dieser Excel-Aufgabe geht es um die Gestaltung einer beliebigen zielführenden Lösung. Wenn dabei auch noch Komfort und Fehlervermeidung berücksichtigt werden, um so besser.

Ich würde mich freuen, wenn Eure Lösungsvorschläge als Kommentar oder Link zu einer Datei in den Kommentaren platziert werden. Meine Lösung folgt erst später…

Mit der folgenden Tabelle hat es jemand gut gemeint, aber die Auswertung in Pivot erschwert sich dadurch.

368

Sobald die Tabelle in eine Liste umformatiert wurde, kann die Datenauswertung in Pivot effizient genutzt werden.

368_1

Und hier geht es zum Video:

Videolink: http://youtu.be/kXcRr0VkTKo

Hier die Datei mit den Übungsdaten der Kreuztabelle:
Excel 468 – Ausgangsdaten

9 Kommentare

  1. Bastian

    Hallo,
    interessante Aufgabe. Wie können Lösungsvorschläge hochgeladen werden?
    Gruß, Bastian

    • thehosblog

      Hallo,

      entweder den Code in den Kommentar oder die Datei z.B. in einem txt-file hochladen und den Link hier veröffentlichen.

      Beste Grüße
      Andreas

  2. Bastian

    Hallo Andreas,
    dann anbei mein Lösungsvorschlag:
    Gruß, Bastian

    Option Explicit

    Sub MakeList()

    Dim wksKreuzTab As Worksheet ‚Tabellenblatt mit Kreuztabelle
    Dim wksListe As Worksheet ‚Tabellenblatt mit Liste
    Dim lngStart As Long ‚Erste Spalte der Kreuztabelle
    Dim lngEnde As Long ‚Letzte Spalte der Kreuztabelle
    Dim lngLZeile As Long ‚Letzte Zeile der Kreuztabelle
    Dim rngRange As Range ‚Bereich links der Kreuztabelle
    Dim i As Integer ‚Zählvariable

    On Error GoTo ErrorHandler

    ‚oberste linke Zelle der Kreuztabelle einlesen
    lngStart = Application.InputBox(„Bitte oberste Linke Zelle der Kreuztabelle markieren“, _
    „Startzelle?“, ActiveCell.Address, Type:=8).Column ‚Erste Spalte der Kreuztabelle

    Application.ScreenUpdating = False

    ‚Neues Tabellenblatt für die Liste anlegen und Objektvariablen zuweisen
    Set wksKreuzTab = ActiveSheet
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = „Liste“
    Set wksListe = ActiveSheet

    ‚Überschriften der Liste erstellen
    With wksListe
    .Cells(1, 1).Value = „Projekt“
    .Cells(1, 2).Value = „Name“
    .Cells(1, 3).Value = „Datum“
    .Cells(1, 4).Value = „Monat“
    .Cells(1, 5).Value = „Umsatz“
    End With

    ‚Kreuztabelle „auslesen“
    With wksKreuzTab
    lngEnde = .Cells(1, Columns.Count).End(xlToLeft).Column ‚Letzte Spalte der Kreuztabelle
    lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row ‚Letzte Zeile der Kreuztabelle
    Set rngRange = Range(.Cells(2, 1), .Cells(lngLZeile, lngStart – 1)) ‚Bereich links der Kreuztabelle
    End With

    ‚Liste erstellen
    For i = lngEnde To lngStart Step -1
    Rows(„2:“ & lngLZeile).Insert Shift:=xlDown ‚Zeilen einfügen
    rngRange.Copy ‚Bereich links der Kreuztabelle Kopieren
    With wksListe
    .Range(„A2“).PasteSpecial (xlPasteValues) ‚Bereich links der Kreuztabelle einfügen
    Range(.Cells(2, 4), .Cells(lngLZeile, 4)).Value = wksKreuzTab.Cells(1, i).Value ‚Monat einfügen
    Range(wksKreuzTab.Cells(2, i), wksKreuzTab.Cells(lngLZeile, i)).Copy ‚Umsätze kopieren
    .Range(„E2“).PasteSpecial (xlPasteValues)
    End With
    Next i

    Set wksKreuzTab = Nothing
    Set wksListe = Nothing

    Application.ScreenUpdating = True
    Exit Sub

    ErrorHandler:
    MsgBox „Erzeugung der Liste abgebrochen!“, , „Hoppla“, vbCritical, vbOK
    End Sub

    • thehosblog

      Hey! Danke erstmal!
      Beim Kopieren ins Excel muss man hier leider noch einige Symbole ersetzen, zum Beispiel die ganzen Anführungsstriche und Hochkommata. Ich werde am Wochenende mal drauf gucken. Bis dahin habe ich leider noch zu viel um die Ohren.
      Bei Range(.Cells(2, 4), .Cells(lngLZeile, 4)).Value schimpft mein System noch… Bis später 😉

  3. Bastian

    Hallo Andreas,
    noch eine Variante mit Array. Hoffe, diesmal ohne Probleme mit Hochkommata und Anführungsstrichen 😉
    Gruß, Bastian

    Sub MakeList_2()
    ‚Kreuztabelle in Liste umwandeln

    Dim wksKreuzTab As Worksheet ‚Tabellenblatt mit Kreuztabelle
    Dim wksListe As Worksheet ‚Tabellenblatt mit Liste
    Dim lngStart As Long ‚Erste Spalte der Kreuztabelle
    Dim varListe As Variant ‚Array, in dem die Datensätze der Kreuztabelle abgelegt werden
    Dim r As Integer ‚Zählvariable Zeilen der Liste
    Dim c As Integer ‚Zählvariable Spalten der Liste
    Dim i As Integer ‚Zählvariable

    On Error GoTo ErrorHandler

    ‚Kreuztabelle in Array einlesen
    varListe = ActiveSheet.UsedRange

    ‚oberste linke Zelle der Kreuztabelle einlesen
    lngStart = Application.InputBox(„Bitte oberste Linke Zelle der Kreuztabelle markieren“, _
    „Startzelle?“, ActiveCell.Address, Type:=8).Column ‚Erste Spalte der Kreuztabelle

    Application.ScreenUpdating = False

    ‚Neues Tabellenblatt für die Liste anlegen und Objektvariablen zuweisen
    Set wksKreuzTab = ActiveSheet
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = „Liste“
    Set wksListe = ActiveSheet

    ‚Überschriften der Liste erstellen
    With wksListe
    .Cells(1, 1).Value = varListe(1, 1) ‚Projekt
    .Cells(1, 2).Value = varListe(1, 2) ‚Name
    .Cells(1, 3).Value = varListe(1, 3) ‚Datum
    .Cells(1, 4).Value = „Monat“
    .Cells(1, 5).Value = „Umsatz“
    End With

    ‚Liste erstellen
    i = 0
    ‚Schleife über die Monate
    For c = lngStart To UBound(varListe, 2)
    ‚Innere Schleife ueber die Zeilen
    For r = 2 + (i * (UBound(varListe, 1) – 1)) To UBound(varListe, 1) + (i * (UBound(varListe, 1) – 1))
    With wksListe
    .Cells(r, 1).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), 1) ‚Projekt
    .Cells(r, 2).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), 2) ‚Name
    .Cells(r, 3).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), 3) ‚Datum
    .Cells(r, 4).Value = varListe(1, c) ‚Monat
    .Cells(r, 5).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), c) ‚Umsatz
    End With
    Next r
    i = i + 1
    Next c

    Set wksKreuzTab = Nothing
    Set wksListe = Nothing

    Application.ScreenUpdating = True
    Exit Sub

    ErrorHandler:
    MsgBox „Erzeugung der Liste abgebrochen!“, , „Hoppla“, vbCritical, vbOK
    End Sub

      • Bastian

        Hi,
        zu früh gefreut. Hochkommata, Anführungszeichen und Minuszeichen müssen ersetzt werden.
        Gruß, Bastian

    • Bastian

      Korrektur:
      Der Bereich links der Daten wird nun korrekt wiedergegeben (abhängig davon, in welcher Spalte der Datenbereich der Kreuztabelle beginnt).
      Gruß, Bastian

      Sub MakeList_2()
      ‚Kreuztabelle in Liste umwandeln

      Dim wksKreuzTab As Worksheet ‚Tabellenblatt mit Kreuztabelle
      Dim wksListe As Worksheet ‚Tabellenblatt mit Liste
      Dim lngStart As Long ‚Erste Spalte der Kreuztabelle
      Dim varListe As Variant ‚Array, in dem die Datensätze der Kreuztabelle abgelegt werden
      Dim r As Integer ‚Zählvariable Zeilen der Liste
      Dim c As Integer ‚Zählvariable Spalten der Liste Datenbereich
      Dim c2 As Integer ‚Zählvariable Spalten der Liste links vom Datenbereich
      Dim i As Integer ‚Zählvariable

      On Error GoTo ErrorHandler

      ‚Kreuztabelle in Array einlesen
      varListe = ActiveSheet.UsedRange

      ‚oberste linke Zelle der Kreuztabelle einlesen
      lngStart = Application.InputBox(„Bitte oberste Linke Zelle der Kreuztabelle markieren“, _
      „Startzelle?“, ActiveCell.Address, Type:=8).Column ‚Erste Spalte der Kreuztabelle

      Application.ScreenUpdating = False

      ‚Neues Tabellenblatt für die Liste anlegen und Objektvariablen zuweisen
      Set wksKreuzTab = ActiveSheet
      Sheets.Add After:=Sheets(Sheets.Count)
      ActiveSheet.Name = „Liste“
      Set wksListe = ActiveSheet

      ‚Überschriften der Liste erstellen
      With wksListe
      For c2 = 1 To lngStart – 1
      .Cells(1, c2).Value = varListe(1, c2)
      Next c2
      .Cells(1, lngStart).Value = „Monat“
      .Cells(1, lngStart + 1).Value = „Umsatz“
      End With

      ‚Liste erstellen
      i = 0
      ‚Schleife über die Monate
      For c = lngStart To UBound(varListe, 2)
      ‚Innere Schleife ueber die Zeilen
      For r = 2 + (i * (UBound(varListe, 1) – 1)) To UBound(varListe, 1) + (i * (UBound(varListe, 1) – 1))
      With wksListe
      For c2 = 1 To lngStart – 1
      .Cells(r, c2).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), c2)
      Next c2
      .Cells(r, lngStart).Value = varListe(1, c) ‚Monat
      .Cells(r, lngStart + 1).Value = varListe(r – (i * (UBound(varListe, 1) – 1)), c) ‚Umsatz
      End With
      Next r
      i = i + 1
      Next c

      Set wksKreuzTab = Nothing
      Set wksListe = Nothing

      Application.ScreenUpdating = True
      Exit Sub

      ErrorHandler:
      MsgBox „Erzeugung der Liste abgebrochen!“, , „Hoppla“, vbCritical, vbOK
      End Sub

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