Office: String trennen und in neue Zellen einfügen

Hallo,

ich bin neu in VBA und habe gleich mal eine Frage *Smilie

Meine Aufgabenstellung ist folgende.
wir haben mehrere Excel Tabellen in welchen viele Zellen existieren, die mehrere Zeichenfolgen haben.
Meine Aufgabe ist es diese großen Zellen zu löschen und die Zeichenketten in diesen Zellen in kleinere Zellen zu schreiben, d.h. dass jede Zeichenkette der großen Zelle in eine kleine (also normale Excel-Zelle) geschrieben wird.
Dies möchte ich gerne mit einem Makro lösen, da es doch sehr viel Arbeit beinhaltet.
D.h. ich möchte ein Makro, welches die Zeichenkette der großen Zelle liest, neue leere Zellen einfügt, und die einzelnen Zeichenketten, welche durch ein chr(10) getrennt sind, einzeln in die neuen Zellen schreibt.

Ich bin so weit gekommen, dass ich die Zeichenkette trennen und auch in neue Zellen untereinander schreiben kann, jedoch überschreibt er mir die unteren Zellen. Wenn ich neue Zellen einfüge, dann fügt er mir neue Zellen zwar ein, aber nicht die getrennten Zeichenketten. D.h. das Makro macht entweder das eine oder das andere*Smilie

Könnt ihr mit bitte helfen. Hier der Quellcode:

Sub trenne_Zellen()
'große Zelle trennen, Inhalt in neue, kleine Zellen schreiben

'Variablen deklarieren
Dim lngZ As Long
Dim strTeilstring() As String
Dim strTrennzeichen As String

'Vorgaben definieren
Set wsakt = ThisWorkbook.Sheets("Redaktion") 'sollte aktives Blatt sein / active.sheet
lngZ = 17 'Startzeile; muss in jedem Blatt festgelegt werden // markierte Zelle bearbeiten z.B. range.selection
strTrennzeichen = Chr(10) 'Trennzeichen festlegen; müsste bei uns ein Zeilenumbruch sein chr(10)
'Durchlaufen aller Datenzeilen // soll nur die aktuelle markierte Zelle bearbeiten
For x = 17 To 18

'Teilstring am Zeilenumbruch auslesen
strTeilstring = Split(Trim(wsakt.Cells(lngZ, 2).Value), strTrennzeichen)


'Durchlaufen des gesamten Arrays einer Zelle vom ersten bis zum letzten Wert
For a = LBound(strTeilstring) To UBound(strTeilstring)

'Array-Elemente nacheinander eintragen
wsakt.Cells(lngZ, 2).Value = Trim(strTeilstring(a)) ' schreibt Werte in die vorgegebene Zelle
' Ziel: Original Zelle löschen und jeden String in eine neue Zelle schreiben

'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'ActiveSheet.Cells(x, 1).EntireRow.Insert
'ActiveSheet.Paste
'Zeilenzähler erhöhen
lngZ = lngZ + 1
'neue Zeile einfügen
'ActiveSheet.Cells(17, 1).EntireRow.Insert 'fügt neue leere Zelle ein; so erst einmal richtig aber: die neue Zelle muss befüllt werden.

Next a

Next x

End Sub

Vielen Dank schon mal*Smilie

:)

 

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren untereinander?
Danke.

Gruß,
steve1da

 

Hi Steve,

ich weis nicht genau was du meinst.
Meinst du meine Frage in einem anderen Forum?

Kann ich gerne machen.

http://www.vba-forum.de/Forum/View.a...ellen_einfügen

 

Hola,

genau das meine ich.

Gruß,
steve1da

 

Ah so ok sorry, daran habe ich nicht gedacht.