Clever-Excel-Forum

Moin

Mit Power Query sind es nur ein paar Schritte.

In VBA nur 1:



Oder:

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

Hallo Günter,

(26.02.2019, 09:24)WillWissen schrieb: [ -> ]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

(26.02.2019, 13:01)snb schrieb: [ -> ]In VBA nur 1...

Hallo, geschrieben hast du definitiv mehr...

(26.02.2019, 13:05)Kuwer schrieb: [ -> ]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!

Dann hat sich deine PN wohl erledigt.

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!

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

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.
Schließen und laden in Tabelle/Bestehendes Arbeitsblatt/$H$10.