MultiLine Werte aus einer Zelle in einzelne Zellen schreiben

[friedensbringer]

Hallo zusammen,

ich hoffe ihr könnt mir bei einem VBA Problem helfen.

Die Datei habe ich beiliegend angehängt und ich bin auch schon recht weit gekommen, es fehlt aus meiner Sicht noch ein (kleiner aber sehr wichtiger) Schritt.

Register: Originaldaten (so bekomme ich die Auswertung)
Register: Aufbereitet (hier sollen die Daten laut Makro "Aufbereiten" entsprechend aufbereitet werden

Ich habe versucht das Makro so gut wie möglich zu kommentieren.

Spalte A = Kundennummer
Spalte B = Artikelnummer
Spalte C = CrossSelling Artikel

Ich brauche nun aber alle Daten in nur 2 Spalten statt 3 Spalten.

Spalte E = Kundennummer
Spalte G = Artikelnummer (der CrossSelling Artikel)

Ich habe auf Stackoverflow ein Makro gefunden ("Sub multilineCellsToSeparateCells(rng As Range)"), das schon fast genau das macht was ich will, nämlich die Werte aus der Spalte C von Werten die untereinander in einer einzelnen Zelle stehen in einzelne Zellen zu schreiben (Spalte G). Ich denke man sieht das auch ganz gut am beiliegenden Screenshot.

Mein Problem ist aber, dass ich das aktuell nur für eine Spalte, also C zu G machen kann.
In Spalte E müsste immer der passende account (Kundennummer) stehen. Man sieht hier, dass die Werte hier irgendwann enden, die Spalte A also genau gleich lang wie die Spalte E ist.

Für die ersten Wertepaare müsste also in E2 - E7 die erste Kundennummer aus A2 stehen (das passt nicht, bzw. irgendwann nicht mehr) und in Spalte G2 - G7 die Werte aus Zelle C2 aber eben in einzelnen Zeilen (das passt).

In Spalte D zähle ich die Anzahl der Einträge pro Zelle in Spalte C, ich könnte also eine Schleife bauen wo ich den jeweiligen Wert aus A so oft in Spalte E untereinander kopiere.
Wäre aber ein "dirty Workaround" und ich hätte das gerne sauber / eleganter gelöst.

Am Ende ergänze ich dann die Spalte E unter der Spalte A und die Spalte G unter der Spalte B und lösche anschließend noch die Spalten C-G löschen, sortierte die Daten nach accountnummer, entferne Duplikate etc.

Ich hoffe sehr jemand von euch kann mir da helfen.

Vielen Dank schon im Voraus und lg

Olli

[snb]

Code:

Sub M_snb()
  Tabelle2.Activate
  ActiveWindow.FreezePanes = False

  sn = Tabelle2.Cells(1).CurrentRegion
  ReDim sp(UBound(sn) * 10, 1)
 
  For j = 1 To UBound(sn)
      sp(y, 0) = sn(j, 1)
      sp(y, 1) = sn(j, 2)
      y = y + 1
      st = Split(sn(j, 3), vbLf)
      For jj = 0 To UBound(st)
        sp(y, 0) = sn(j, 1)
        sp(y, 1) = st(jj)
        y = y + 1
      Next
  Next
 
  Tabelle2.Cells(1, 4).Resize(UBound(sp), 2) = sp
End Sub

[friedensbringer]

Hallo snb,

vielen Dank für deine Antwort. Kannst du mir sagen wo ich das einbauen müsste?

Direkt in meinem Makro "Aufbereiten" oder irgendwo im Makro "multilineCellsToSeparateCells"

Ich rufe dieses zweite Makro ja einmal für eine Spalte wie folgt auf:

Call multilineCellsToSeparateCells(ActiveSheet.Columns("G")) 'Hier müsste nicht nur die Spalte G berücksichtigt werden, sondern auch die Spalte E und F

Ich gehe davon aus, dass ich mit deinem Code zwei Spalten berücksichtigen kann, weiß nur noch nicht ganz genau wo einbauen.

Vielen Dank und lg

Olli

[Cadmus]

Geht auch mit PowerQuery statt VBA.

[snb]

wo ich das einbauen müsste?

Im  Makromodul des Arbeitsblattes Tabelle2.

[friedensbringer]

Hallo Cadmus,

vielen Dank, kann die Beispieldatei aber leider nicht herunterladen bzw. danach öffnen.
Wäre es eventuell möglich, dass du sie als *.zip Datei hochlädst?

Danke und lg

Olli

[Cadmus]

Dann stimmt mit deinem Download etwas nicht. Die Datei ist OK. Aber ich häng sie an.

[friedensbringer]

Hallo Cadmus,

sehr cool - jetzt funktioniert es auch bei mir.
Diese Lösung gefällt mir ebenfalls sehr gut, immer wieder cool zu sehen was man mit Power Query machen kann,
definitiv ein Bereich in dem ich noch sehr viel lernen kann / will.

Vielen Dank und lg

Olli