Zellinhalt auf mehrere Zeilen aufteilen

Hallo zusammen,
ich sitze gerade vor einem Problem bei Excel und komme bei einem Teilproblem nicht richtig voran.
Es geht um eine Tabelle, die sich über mehrere Spalten und Zeilen erstreckt. In einer Spalte befinden sich Nummern, die jeweils mit dem Buchstaben A beginnen. In manchen Zellen stehen allerdings zwei Nummern, die mit einem "/" getrennt sind. Sollte dies der Fall sein, muss die zweite Nummer in die nächste Zeile, d.h. es müsste eine neue Zeile eingefügt werden, in die die zweite Nummer nach dem Slash eingefügt wird. In der darauffolgenden Spalte müssen ebenfalls zwei Zahlen getrennt werden. Daraufhin bleibt aber der Zeileninhalt erhalten und ist für beide Zeilen gleich.
Ich habe eine Beispieldatei erstellt und hoffe, dass es damit anschaulicher wird. Ich suche hierfür einen Code, damit Excel dies für mich erledigt. Man kann doch bestimmt eine Schleife laufen lassen, die bei dem Slash-Zeichen Alarm schlägt oder?!
Bin für jeden Ansatz und jede Erklärung dankbar. Vielleicht schaffe ich es dann das nächste mal ohne Hilfe :)
Bei Rückfragen einfach melden.
https://www.herber.de/bbs/user/126634.xlsx
Vielen vielen Dank vorab und schöne Grüße
Flo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Flo,
Probier mal ob das bei dir klappt. Erste Spalte muss die Spalte mit den A... Codes sein, also bitte alles andere (wie "vorher" in deinem Beispiel) löschen oder die Bezugsspalte anpassen.
Ist bestimmt umständlicher als es sein müsste aber funktioniert bei mir.
Grüße
Daniel M.

Sub Zellen_Aufteilen()
Dim Tabelle As Range, cell As Range
Dim Position(0 To 1) As Variant, ColumnAB As Integer
Dim ZuKopieren(0 To 1) As String, ZuLoeschen(0 To 1) As String, NeuerText(0 To 1) As String
Set Tabelle = ActiveSheet.UsedRange
For Each cell In Tabelle.Columns(1).Cells
If Not cell.Find("/") Is Nothing Then
For ColumnAB = 0 To 1
Position(ColumnAB) = InStr(1, cell.Offset(0, ColumnAB).Value, "/")
ZuKopieren(ColumnAB) = Mid(cell.Offset(0, ColumnAB), Position(ColumnAB) + 1)
ZuLoeschen(ColumnAB) = Mid(cell.Offset(0, ColumnAB), Position(ColumnAB))
NeuerText(ColumnAB) = Replace(cell.Offset(0, ColumnAB), ZuLoeschen(ColumnAB), "")
cell.Offset(0, ColumnAB) = NeuerText(ColumnAB)
Next ColumnAB
cell.Rows.EntireRow.Offset(1, 0).Insert (xlDown)
cell.Offset(1, 0) = ZuKopieren(0)
cell.Offset(1, 1) = ZuKopieren(1)
Range(cell.Offset(1, 2), cell.Offset(1, Tabelle.Columns.Count - 1)) = _
Range(cell.Offset(0, 2), cell.Offset(0, Tabelle.Columns.Count - 1))
Tabelle.Resize(Tabelle.Rows.Count, Tabelle.Columns.Count).Activate
End If
Next cell
End Sub

Beliebteste Forumthreads (12 Monate)

Zellinhalt auf mehrere Zeilen aufteilen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread