Mehrere Werte in einer Zelle (mit Zeilenumbruch) untereinander ausgeben

[shift-del]

Moin

Mit Power Query sind es nur ein paar Schritte.

Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Spalte1", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Spalte1"),
    #"Split Column by Delimiter1" = Table.SplitColumn(#"Split Column by Delimiter", "Spalte1", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Spalte1.1", "Spalte1.2"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Spalte1.1", type text}, {"Spalte1.2", Int64.Type}})
in
    #"Changed Type1"

[snb]

In VBA nur 1:

Code:

Sub M_snb()
   sn = Split(Join(Application.Transpose(Cells(4, 1).CurrentRegion), vbLf), vbLf)
   ReDim sp(UBound(sn), 1)
   
   For j = 0 To UBound(sn)
      st = Split(sn(j), ":")
      sp(j, 0) = st(0)
      sp(j, 1) = st(1)
   Next
   
   Cells(30, 1).Resize(UBound(sp) + 1, 2) = sp
End Sub

Oder:

Code:

Sub M_snb()
   sn = Split(Join(Application.Transpose(Cells(4, 1).CurrentRegion), vbLf), vbLf)
   Cells(30, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
   Cells(30, 1).CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, ":"
End Sub

[Kuwer]

Hallo YungKafa,

hier mein VBA-Vorschlag mit eingebautem Schritt 2:

Sub TransponierenSpezial_V2()
 Dim rngB As Range
 Dim varQ As Variant, varZ As Variant
 Dim varTs As Variant, varTz As Variant
 Dim i As Long, j As Long
 
 Set rngB = Worksheets("Tabelle1").Range("A4") 'Zelle mit dem ersten Datensatz
 
 varQ = Range(rngB, rngB.End(xlDown)).Resize(, 2).Value
 ReDim varZ(1 To 2, 0 To 0)
 For i = 1 To UBound(varQ)
   varTz = Split(varQ(i, 1), Chr(10))
   ReDim Preserve varZ(1 To 2, 1 To UBound(varZ, 2) + UBound(varTz) + 1)
   For j = 0 To UBound(varTz)
     varTs = Split(varTz(j), ":")
     varZ(1, UBound(varZ, 2) - UBound(varTz) + j) = varTs(0)
     If UBound(varTs) = 0 Then
       varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 2)
     Else
       varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varTs(1)
     End If
   Next j
 Next i
 rngB.Resize(UBound(varZ, 2), UBound(varZ, 1)).Value = Application.Transpose(varZ)
End Sub

Gruß Uwe

[Kuwer]

Hallo Günter,

Moin,

deiner Beispieltabelle nach kommt Text in Spalten infrage. Wieso lädtst du nicht eine Beispieltabelle wie ich es in #2 geschrieben habe, hoch???
Wenn du von "sehr vielen Daten bearbeiten" schreibst, dürfte das Beispiel nicht unbedingt hilfreich sein.

es wäre für alle Beteiligten viel entspannter, Du würdest Dich einfach zurückhalten , wenn Du es nicht blickst.

Gruß Uwe

[Jockel]

In VBA nur 1...

Hallo, geschrieben hast du definitiv mehr...

[YungKafa]

Hallo YungKafa,

hier mein VBA-Vorschlag mit eingebautem Schritt 2:

Sub TransponierenSpezial_V2()
 Dim rngB As Range
 Dim varQ As Variant, varZ As Variant
 Dim varTs As Variant, varTz As Variant
 Dim i As Long, j As Long
 
 Set rngB = Worksheets("Tabelle1").Range("A4") 'Zelle mit dem ersten Datensatz
 
 varQ = Range(rngB, rngB.End(xlDown)).Resize(, 2).Value
 ReDim varZ(1 To 2, 0 To 0)
 For i = 1 To UBound(varQ)
   varTz = Split(varQ(i, 1), Chr(10))
   ReDim Preserve varZ(1 To 2, 1 To UBound(varZ, 2) + UBound(varTz) + 1)
   For j = 0 To UBound(varTz)
     varTs = Split(varTz(j), ":")
     varZ(1, UBound(varZ, 2) - UBound(varTz) + j) = varTs(0)
     If UBound(varTs) = 0 Then
       varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 2)
     Else
       varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varTs(1)
     End If
   Next j
 Next i
 rngB.Resize(UBound(varZ, 2), UBound(varZ, 1)).Value = Application.Transpose(varZ)
End Sub

Gruß Uwe

Wahnsinn! Danke für Eure großartige Unterstützung. Ich habe jetzt alle Vorschläge getestet und alle führen zu dem gewünschten Ergebnis. Ich werde es jetzt mit meinen Originaldaten versuchen!

[shift-del]

Dann hat sich deine PN wohl erledigt.

[YungKafa]

Ich brauche doch nochmal Eure Hilfe.

Die von euch vorgeschlagenen Codes erfüllen definitiv meine Anforderung aus dem ersten Post.

Jedoch enthält meine Tabelle noch weitere Informationen, die - in der Ausgangssituation - nur einmal vorkommen. Wenn die Datensätze aus der Ausgangssituation jetzt getrennt werden, möchte ich, dass diese übrigen Informationen kopiert werden, sodass jeder neue Datensatz, diese Informationen ebenfalls enthält.

Beispielv2 ist im Anhang.

An die VBA Profis: Es wäre nett von Euch, wenn ihr in Euren Codes Kommentare an den Stellen einfügen könntet (hier schon mal danke an Uwe), die ich später anpassen muss, um Euren Code an meine Originaldatei anzupassen. Ich bin leider kompletter Laie und verstehe die Codes nicht.

Danke!

[Jockel]

Hallo... Detlef's (shift-del) Idee passt auch hier... keine Anpassung nötig...

[shift-del]

Hallo YungKafa

Keine Ahnung warum du mir immer PNs schreibt. Dies ist ein öffentliches Forum.

Daten markieren.
STRG-A und OK.
Daten abrufen aus Tabelle.
Ansicht -> Erweiterter Editor.
Den bisherigen Code löschen und meinen Code einfügen.

Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Spalte1", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Spalte1"),
    #"Split Column by Delimiter1" = Table.SplitColumn(#"Split Column by Delimiter", "Spalte1", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Spalte1.1", "Spalte1.2"}),
    #"Changed Type2" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Spalte1.1", type text}, {"Spalte1.2", Int64.Type}, {"Spalte2", type text}, {"Spalte3", type text}, {"Spalte4", type text}})
in
    #"Changed Type2"

Schließen und laden in Tabelle/Bestehendes Arbeitsblatt/$H$10.