ovu-p86
Jan 09, 2014
view18089
view4
0
Goto Top

Excel - Daten aus einer Zeile in mehrere Zeilen aufteilen

GermansolvedQuestionMicrosoft OfficeMicrosoft
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 226206

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

Printed on: April 24, 2024 at 11:04 o'clock

4 Comments
Latest comment
Goto Top
Member: colinardo
Solution colinardo Jan 09, 2014 updated at 15:35:11 (UTC)
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
heart1
Member: ovu-p86
ovu-p86 Jan 09, 2014 at 14:38:07 (UTC)
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
Member: colinardo
Solution colinardo Jan 09, 2014 updated at 15:34:46 (UTC)
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
heart2
Member: ovu-p86
ovu-p86 Jan 09, 2014 at 15:32:14 (UTC)
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
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments