Text splitten III.
bernie
ich hatte bereits zum Thema mehrere Antworten bekommen. Gerd L hatte gefragt, was ich denn von Luc verwendet hatte, um Text (mehr als 265 Zeichen) splitten zu können.
Luc hatte auf verweisen:
Rem Fkt fügt Zeilenumbrüche in Text an prädest Stelle ein (teilw erweit Var zu TinLines aus _
FXss)
' Max Länge von Bezug ist 255 Zeichen (ggf Bezug teilen), wenn er keinen Bereich reprä _
sentiert;
' wenn Arg2 fehlt, ergibt sich maxZeilenlänge als 2xQuotient aus FmlZellBreite u.-Schriftgröß _
e;
' wenn Argg3-5 fehlen, entfallen die entsprd Operationen - Arg3 ist Relativ- _
Silbentrennzeichen,
' Arg4 gibt evtl Einzug nach Zeilenumbruch an (mfache Leerzeichenzahl, MindLeerzAnzahl ca 1-3) _
,
' Arg5 gibt an, ob es sich um Nicht-Proportionalschrift handelt (Courier wird automat erkannt) _
.
' Vs1.2 - Autor: LSr - 1pub: Herber 20090513(1.0)/0701(1.2) - cd: 20090513 - lupd: 20090626n
Function TxRows(ByVal Bezug As String, Optional ByVal maxZeilLg As Integer, Optional ByVal _
relTrennZ _
As String, Optional ByVal relEinzug As Integer, Optional npFont As Boolean)
Const nZtrenn As String = "&/}])>|=\*+~;,:._-", vZtrenn As String = "&/{[( "")
c = vbLf & String(CInt(relEinzug * (Qws / rezMp) ^ (1 + npFont)), " ")
While i + t 0 Then
For j = 1 To i + t: t = t - CInt(Mid(a, j, 1) = relTrennZ): Next j
If t > 0 Then
For j = 1 To t: t = t - CInt(Mid(b, j, 1) = relTrennZ): Next j
a = Left(b, i + t)
End If
End If
b = Mid(b, i + t + 1)
If Left(b, 1) = " " Then
TxRows = TxRows & a & c: b = Mid(b, 2)
ElseIf Right(a, 1) = " " Then
TxRows = TxRows & Left(a, Len(a) - 1) & c
ElseIf Left(b, 1) = relTrennZ Then
TxRows = TxRows & a & "-" & c
ElseIf Right(a, 1) = relTrennZ Then
TxRows = TxRows & Left(a, Len(a) - 1) & "-" & c
ElseIf InStr(vZtrenn, Left(b, 1)) > 0 Or InStr(nZtrenn, Right(a, 1)) > 0 Then
TxRows = TxRows & a & c
Else: i = i - 1: w = True: b = a & b
End If
If w Then
If i + t 0 Then
maxZeilLg = CInt((maxZeilLg - relEinzug) * mzlRd ^ (1 + npFont))
relEinzug = 0
End If
Wend
TxRows = TxRows & b: Set ac = Nothing
If r Then TxRows = Replace(TxRows, relTrennZ, "")
End Function
Um die
Function anzusteuern, hatte ich die Formel
=LINKS(TxRows(LINKS(a1;255);245);SUCHEN(ZEICHEN(10);TxRows(LINKS(a1;255);245))-1)
verwendet. Da in A1 aber Text - blödsinnigerweise bis 900 Zeichen steht - möchte ich diesen so _
trennen, daß in B1, C1 usw. der weitere Text mit max. Länge von 265 Zeichen steht.
Ich könnte mir als VBA laie das Ganze so verstellen, daß zunächst der Text als gesamtes _
ausgelesen und dann gesplittet und die Nachbarzellen (B1, C1 ...) bis zum Textende ausgegeben wird.
Leider fehlt mir da jede Peilung.
Bernie