Tipps & Tricks
18.10.2007, 14:30 Uhr
Excel: Nur Teile der Zeilen in Spalten umwandeln
Problem: Ich habe eine vierspaltige Tabelle, welche in folgendem Format aufgebaut ist: Die erste Zeile enthält «Art.A, RabattA, RabattB, RabattC», die zweite «Art.B, RabattA, RabattB, RabattC» und so weiter. Daraus möchte ich gerne eine Tabelle mit nur zwei Spalten machen, Zeile 1 also «Art.A, RabattA», Zeile 2 «Art.A, RabattB» etc. Mit der Transponieren-Funktion hat das leider nicht geklappt. Wie kann ich die Tabelle in dieses Format konvertieren?
Lösung: Sie haben also vermutlich eine Situation wie in diesem Screenshot:
Mit dem untenstehenden VBA-Code sollte es gehen. Öffnen Sie Extras/Makro/Makros, geben Sie als Name fürs Makro «Rabattstruktur» ein und klicken Sie auf Erstellen.
Erstellen Sie das Excel-Makro
Es öffnet sich der Visual-Basic-Editor, in welchem die zwei Zeilen «Sub Rabattstruktur()» und «End Sub» zu sehen sind, die Sie jetzt löschen. Kopieren Sie nun folgenden Quellcode und fügen Sie diesen dort ein:
Sub Rabattstruktur()
zeile = 1
spalte = 1
bspalte = 1
bzeile = 1
Do While Cells(zeile, spalte) <> ""
If Cells(zeile + 1, spalte) <> Cells(zeile, spalte) Then
'Art-Sprung erkannt
bzeile = zeile
bspalte = 1
counter = 0
'Rabatte werden von links nach rechts "abgemäht"
Do While Cells(bzeile, spalte + 1) <> ""
'Anzahl Rabatte zählen für Rückschritt bei Löschung Ursprungszeile
counter = counter + 1
'Umstrukturierung
Cells(zeile + 1, bspalte).EntireRow.Insert
Cells(zeile + 1, bspalte) = Cells(bzeile, bspalte)
Cells(zeile + 1, bspalte + 1) = Cells(bzeile, spalte + 1)
zeile = zeile + 1
spalte = spalte + 1
Loop
Else
zeile = zeile + 1
End If
spalte = 1
'Rückschritt und Ursprungszeile löschen
If zeile > counter Then
Cells(zeile - counter, spalte).EntireRow.Delete
Else
End If
Loop
End Sub
zeile = 1
spalte = 1
bspalte = 1
bzeile = 1
Do While Cells(zeile, spalte) <> ""
If Cells(zeile + 1, spalte) <> Cells(zeile, spalte) Then
'Art-Sprung erkannt
bzeile = zeile
bspalte = 1
counter = 0
'Rabatte werden von links nach rechts "abgemäht"
Do While Cells(bzeile, spalte + 1) <> ""
'Anzahl Rabatte zählen für Rückschritt bei Löschung Ursprungszeile
counter = counter + 1
'Umstrukturierung
Cells(zeile + 1, bspalte).EntireRow.Insert
Cells(zeile + 1, bspalte) = Cells(bzeile, bspalte)
Cells(zeile + 1, bspalte + 1) = Cells(bzeile, spalte + 1)
zeile = zeile + 1
spalte = spalte + 1
Loop
Else
zeile = zeile + 1
End If
spalte = 1
'Rückschritt und Ursprungszeile löschen
If zeile > counter Then
Cells(zeile - counter, spalte).EntireRow.Delete
Else
End If
Loop
End Sub
So sieht das dann im Visual-Basic-Editor aus:
Das Makro im VB-Editor von Excel
Kehren Sie danach über's Datei-Menü zurück ins Excel, rufen Sie mit dem Tastenkürzel Alt+F8 die Makros auf, wählen Sie «Rabattstruktur» und klicken auf Ausführen. Schon baut das Makro die Tabelle um, die danach so aussieht:
(PCtipp-Forum)
Kommentare
Es sind keine Kommentare vorhanden.
