ovu-p86
Goto Top

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:

4bb4061b2f0adf26939adb2b619abb10



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

Gruß
Uwe

Content-ID: 226206

Url: https://administrator.de/contentid/226206

Ausgedruckt am: 21.11.2024 um 13:11 Uhr

colinardo
Lösung colinardo 09.01.2014 aktualisiert um 16:35:11 Uhr
Goto Top
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 face-smile
ovu-p86
ovu-p86 09.01.2014 um 15:38:07 Uhr
Goto Top
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:

d3f4e6f159f002446f1e7caa9d1755be

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
colinardo
Lösung colinardo 09.01.2014 aktualisiert um 16:34:46 Uhr
Goto Top
kein Problem, hab's dir zusätzlich mit Kommentaren im Code versehen ...face-wink
(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 face-smile

Grüße Uwe
ovu-p86
ovu-p86 09.01.2014 um 16:32:14 Uhr
Goto Top
Hallo colinardo,

funktioniert sofort.

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


Also, RiesenDank

Gruß
Uwe