Zelle trennen nach Leerzeile
06.09.2006 15:29:34
artuk
folgendes Problemche. In einer Zelle steht bei mir z.b. ein kurzer Satz. Diesen Satz möchte ich nun getrennt haben.
Z.b.
A1
Heute ist ein schöner Tag
Nach der Trennung sollte es dann so aussehen:
A1 B1 C1 D1 E1
Heute ist ein schöner Tag
D.h. es müsste nach jeder Leerzeile zwischen den Wörtern getrennt werden.
Habe hier im Forum ein Makro gefunden welches Zellen trennt aber nicht so wie ich es haben möchte leider. Es trennt nach 35 Zeichen.
Option Explicit
'
' das nachfolgende Makro liest die Texte in Spalte A und teilt diese
' wortgerecht getrennt in maximal 35-stellige Teilstrings in die
' Spalten B, C, D und E auf.
' In Spalte E steht evtl. der Rest, der länger als 35 Stellen sein
' kann und der manuell aufgeteilt werden muss.
'
Sub String_aufteilen()
Dim lZeile As Long
Dim lLetzte As Long
Dim iSpalte As Integer
Dim iLaenge As Integer
Dim iPosition As Integer
Dim sZeichen As String
Dim sHiFeld As String
Application.ScreenUpdating = False
lLetzte = IIf([A65536] > "", 65536, [A65536].End(xlUp).Row)
For lZeile = 1 To lLetzte
'If lZeile = 3 Then Stop
sHiFeld = Cells(lZeile, 1).Value
iSpalte = 2
Do
iLaenge = Len(sHiFeld)
If iLaenge < 36 Then Exit Do
iPosition = 36
Do
sZeichen = Mid(sHiFeld, iPosition, 1)
If sZeichen <> " " Then iPosition = iPosition - 1
Loop Until iPosition = 1 Or sZeichen = " "
If iPosition > 1 Then
Cells(lZeile, iSpalte).Value = Left(sHiFeld, (iPosition - 1))
Else
Cells(lZeile, iSpalte).Value = Left(sHiFeld, 1)
End If
iSpalte = iSpalte + 1
sHiFeld = Right(Cells(lZeile, 1).Value, iLaenge - iPosition)
Loop Until Len(sHiFeld) = " "
Cells(lZeile, iSpalte).Value = sHiFeld
Next lZeile
Application.ScreenUpdating = True
End Sub
Wie kann man das modifizieren, damit mein Problemchen gelöst werden kann
Vielen Dank im Voraus
mfg
artuk