Clever-Excel-Forum

Seiten: 1 2 3

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

(26.02.2019, 14:54)shift-del schrieb: [ -> ]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 :)

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

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 Smile

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

@Schauan

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

Seiten: 1 2 3

snb

YungKafa

Kuwer

schauan

snb