Excel - Daten aus einer Zeile in mehrere Zeilen aufteilen

Hallo,

Folgendes bekomme ich nicht gelöst:
Muss eine Excel-Tabelle in eine andere Form übertragen. Arbeite mit Excel 2k.

Die Urtabelle beinhaltet je Artikel alle Staffeln u. dazugehörige Preise in einer Zeile.
Die Anzahl der Staffeln ist unterschiedlich.

Das muss ich umwandeln in eine Tabelle in der jeweils Artikel u. nur eine Staffel mit dem
dazugehörige Preis steht und das separat in einer Zeile.

Da es sich um 600 Artikel handelt, suche ich eine Formel- oder und VBA-Lösung.

Zur Verdeutlichung, Beispiel:

Für Anregungen, Konzepte und Lösungen bin ich dankbar.

Gruß
Uwe

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 226206

Url: https://administrator.de/forum/excel-daten-aus-einer-zeile-in-mehrere-zeilen-aufteilen-226206.html

Ausgedruckt am: 22.12.2024 um 01:12 Uhr

4 Kommentare

Neuester Kommentar

Hallo Uwe,
nach deiner Beispiel-Tabelle im Bild und bei 5 Staffeln kannst du es so mit VBA machen:
(Du musst natürlich für deine echte Tabelle die Start-Ausgabe-Zelle in Zeile 6 des Codes anpassen und eventuell die Start-Zelle der Artikelliste in Zeile 4.)

Sub ListeGenerieren()
    Dim sheet As Worksheet, rngOutCurrent As Range, rngInCurrent As Range, rngInStop As Range, rngInStart As Range
    Set sheet = Worksheets("Tabelle1")  
    Set rngInStart = sheet.Range("A6")  
    Set rngInStop = rngInStart.End(xlDown)
    Set rngOutCurrent = sheet.Range("A15")  
    Set rngInCurrent = rngInStart

    For Each cell In sheet.Range(rngInStart, rngInStop)
        For i = 1 To 10 Step 2
            If rngInCurrent.Offset(0, i).Value <> "" Then  
                rngOutCurrent.Value = rngInCurrent.Value
                rngOutCurrent.Offset(0, 1).Value = rngInCurrent.Offset(0, i).Value
                rngOutCurrent.Offset(0, 2).Value = rngInCurrent.Offset(0, i + 1).Value
                Set rngOutCurrent = rngOutCurrent.Offset(1, 0)
            End If
        Next
        Set rngInCurrent = rngInCurrent.Offset(1, 0)
    Next
End Sub

Hier auch ein Demo-Sheet dazu.

Grüße Uwe

Hallo colinardo,

habs gleich probiert.

Perfekt. Hat sofort geklappt

Danke, hatte überhaupt nicht mit sowas konkretem gerechnet.

Jetzt muss ich erstmal deinen Code verstehen.
Ich muss noch folgendes anpassen:

1. zwischen Spalte A und B existieren real noch 2 zusätzliche Spalten die nicht ausgewertet werden müssen
(muss ich wohl was an den Offsets machen, aber ist ja ne Lücke?)
2. es sind maximal 8 Staffeln
(wahrscheinlich "For i = 1 To 16)
3. Ergebnis soll in neues Arbeitsblatt (Tabelle2) geschrieben werden
(ist wohl komplizierter)
4. Im Ergebnis soll eine weitere Spalte mit immer gleichem Text erscheinen
(mach ich wohl mit Befehl "einfügen Spalte, u.s.w.)

also so:

Das hatte ich in der Frage weggelassen, um es nicht noch komplizierter zu machen.
Aber da wusele ich mich schon durch.

Kann den Beitrag im Prinzip auf "gelöst" setzen.
Warte nur noch ein bißchen, falls sich noch eine Frage ergibt.

Nochmals Dank.

Gruß
Uwe

kein Problem, hab's dir zusätzlich mit Kommentaren im Code versehen ...

(hab noch eine Variable entfernt die überflüssig war)
Die Liste wird nun in "Tabelle2" ab Zelle "A2" ausgegeben.

Sub ListeGenerieren()
    Dim sheet As Worksheet, rngOutCurrent As Range, rngInStop As Range, rngInStart As Range
    'Arbeitsblatt in dem die Artikel stehen  
    Set sheet = Worksheets("Tabelle1")  
    'Anfangszelle der Artikel setzen  
    Set rngInStart = sheet.Range("A6")  
    'Den letzen Artikel finden  
    Set rngInStop = rngInStart.End(xlDown)
    'Ausgabe-Startzelle setzen  
    Set rngOutCurrent = Worksheets("Tabelle2").Range("A2")  
    'Für jeden Artikel im Eingabebereich...  
    For Each cell In sheet.Range(rngInStart, rngInStop)
        ' Für jede Staffel ...  
        For i = 3 To 19 Step 2
            'Wenn die Menge der Staffel nicht leer ist dann ...  
            If cell.Offset(0, i).Value <> "" Then  
                'Artikelnamen schreiben  
                rngOutCurrent.Value = cell.Value
                'Konstanten Wert 'Staffelpreis' schreiben  
                rngOutCurrent.Offset(0, 1).Value = "Staffelpreis"  
                'Menge schreiben  
                rngOutCurrent.Offset(0, 2).Value = cell.Offset(0, i).Value
                'Preis schreiben  
                rngOutCurrent.Offset(0, 3).Value = cell.Offset(0, i + 1).Value
                'Ausgabezeile um eine Zeile nach unten verschieben für den nächsten Eintrag  
                Set rngOutCurrent = rngOutCurrent.Offset(1, 0)
            End If
        Next
    Next
End Sub

Jetzt kannste früher Feierabend machen

Grüße Uwe

Hallo colinardo,

funktioniert sofort.

Das mit den Kommentaren ist klasse. Dann kann ich mal nachvollziehen und auch was lernen.

Also, RiesenDank

Gruß
Uwe

gelöst Frage Microsoft Microsoft Office

Mehr von ovu-p86

Google Suche jetzt auf 10 Ergebnisse pro Seite beschränktovu-p86 - 6 Kommentare

Outlook ist zickig, besser Thunderbird, allg. Diskussionovu-p86 - 25 Kommentare

Heimnetz - Rechner klonen - Probleme mit SID?ovu-p86 - 11 Kommentare

Antivirensuite "360 Total Security"ovu-p86 - 17 Kommentare

Heiß diskutiert