Makroänderung Text logisch trennen
08.04.2005 13:08:33
Tim
ich habe den Quelltext bereits aus dem Forum und bitte um Mithilfe diesen für folgende Aufgabe umzustricken.
Ich habe einen Langtext in einer Zelle stehen. Dieser soll wie folgt per Makro aufgeteilt werden:
Ursprungstext= unbestimmte Textlänge
1. zu füllende Zelle darf mit maximal 50 Zeichen gefüllt werden, Wörter dürfen nicht zertrennt werden, diese Prüfung ist in unten genanntem Text aber bereits gegeben.
Die 2. Zelle, rechts neben! der ersten soll ebenfalls mit maximal 50 Zeichen gefüllt werden.
In die 3. Zelle soll der übrige Rest als Langtext geschrieben werden.
Eigentlich erfüllt das Makro schon seinen Zweck, allerdings sollen drei Spalten in das bestehende Tabellenblatt per Makro eingefügt werden.
Ich hoffe ich habe mich einigermaßen verständlich ausgedrückt.
Vielen Dank für Eure Hilfe.
Public
Sub Zerlegen()
Dim strSatz As String
Dim varSatz() As Variant
Dim bytAnz As Byte
Dim lngZeile As Long
'Range("A2:X300").ClearContents
bytAnz = Range("B1")
strSatz = Range("A1")
ReDim varSatz(65536)
Do
If InStrRev(Left(strSatz, bytAnz), " ") = 0 Then
varSatz(lngZeile) = Left(strSatz, InStr(strSatz, " ") - 1)
Else
varSatz(lngZeile) = Left(Left(strSatz, bytAnz), InStrRev(Left(strSatz, bytAnz), " ") - 1)
End If
strSatz = Application.WorksheetFunction.Substitute(strSatz, varSatz(lngZeile) & " ", "", 1)
lngZeile = lngZeile + 1
Loop Until Len(strSatz) <= bytAnz Or InStr(strSatz, " ") = 0
varSatz(lngZeile) = strSatz
ReDim Preserve varSatz(lngZeile)
Range("A2:A" & lngZeile + 2) = Application.WorksheetFunction.Transpose(varSatz())
End Sub