Mehrere Werte in einer Zelle (mit Zeilenumbruch) untereinander ausgeben

[snb]

In VBA:

Code:

Sub M_snb()
   sn = Cells(4, 1).CurrentRegion
   
   For j = 1 To UBound(sn)
       sn(j, 1) = Replace(sn(j, 1) & vbLf, vbLf, ":" & Join(Application.Index(sn, j, Array(2, 3, 4)), ":") & vbLf)
   Next
   
   sn = Filter(Split(Join(Application.Transpose(Application.Index(sn, , 1)), vbLf), vbLf), ":")
   Cells(30, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
   Cells(30, 1).CurrentRegion.TextToColumns , 1, , , 0, 0, 0, 0, -1, ":"
End Sub

[YungKafa]

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.

So geht es. besten Dank! Auch an alle, die ebenfalls Lösungen präsentiert haben :)

[Kuwer]

Hallo YungKafa,

dann hier noch meine 3. VBA-Version:

Sub TransponierenSpezial_V3()
  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
  
  'Zelle mit dem ersten Datensatz festlegen
  Set rngB = Worksheets("Tabelle1").Range("A4") 'Blattnamen und Zelladresse entsprechend anpassen
  'für das aktive Tabellenblatt auch so:
  Set rngB = ActiveSheet.Range("A4") 'Zelladresse entsprechend anpassen
  
  'Quellarray nimmt Daten der ersten Zelle, erweitert um die darunterliegenden Zeilen und 5 Spalten, auf:
  varQ = Range(rngB, rngB.End(xlDown)).Resize(, 5).Value
  'Urdimensionieung des Zielarrays:
  ReDim varZ(1 To 5, 0 To 0)
  'Schleife durch Zeilen des Quellarrays:
  For i = 1 To UBound(varQ)
    'Aufteilung Datensätze in einer Zelle nach Zeilenumbrüchen:
    varTz = Split(varQ(i, 1), Chr(10))
    'Erweiterung der letzten Dimension des Zielarrays um Anzahl neuer Datensätze:
    ReDim Preserve varZ(1 To 5, 1 To UBound(varZ, 2) + UBound(varTz) + 1)
    'Schleife durch Datensätze (ursprünglich einer Zelle):
    For j = 0 To UBound(varTz)
      varTs = Split(varTz(j), ":")  'Auftrennung einzelner DS nach ":"
      If UBound(varTs) = 0 Then 'wenn die Aufteilung auf Spalten schon erfolgte,
        'dann Einszueinsübertrag von Quellarray zu Zielarray:
        varZ(1, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 1)
        varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 2)
        varZ(3, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 3)
        varZ(4, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 4)
        varZ(5, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 5)
      Else
        'sonst Spalte 1 umgewandelt ins Zielarray Spalten 1 und 2:
        varZ(1, UBound(varZ, 2) - UBound(varTz) + j) = varTs(0)
        varZ(2, UBound(varZ, 2) - UBound(varTz) + j) = varTs(1)
        'Spalten vorher 2 bis 4 nach Spalten neu 3 bis 5:
        varZ(3, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 2)
        varZ(4, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 3)
        varZ(5, UBound(varZ, 2) - UBound(varTz) + j) = varQ(i, 4)
      End If
    Next j
  Next i
  'transponiertes Zielarray wird zurückgeschrieben in Zellbereich:
  rngB.Resize(UBound(varZ, 2), UBound(varZ, 1)).Value = Application.Transpose(varZ)
End Sub

Gruß Uwe

[schauan]

Hallöchen,

hier mal noch meine kurze Variante für die Spalte A. Ist ähnlich wie von snb und ich hab mal die Enumerations von snb mitgenommen. Hauptsache, Billyboy hat da zwischen den Versionen keine Nummern geschoben

Code:

Option Explicit
Option Base 1

Sub Auseinander()
Dim arrtemp
arrtemp = WorksheetFunction.Transpose(Split(Join(WorksheetFunction.Transpose(Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value), vbLf), vbLf))
With Cells(1, 1).Resize(UBound(arrtemp, 1), 1)
  .Value = arrtemp
  .TextToColumns , 1, , , 0, 0, 0, 0, -1, ":"
End With
End Sub

[snb]

@Schauan

Application.transpose ist robuster als worksheetfunction.transpose (dokumentierter Bug).