AW: Nachtrag
02.02.2011 15:51:13
ing.grohn
Hallo Luc,
nur zur Info:
Function meinSplit(strText As String, L As Integer) As Variant
Dim arrText() As String
Dim TL As Integer
Dim T As Double
Dim Posi As Integer
Dim I As Integer
Dim Z As Integer
Dim Arr As Integer
Dim Ende As Boolean
I = 0
TL = Len(strText)
T = TL / L
Arr = Int(T + 1)
ReDim arrText(Arr - 1)
Do
TL = Len(strText)
If TL > L Then
Posi = InStr(L, strText, " ")
If Posi > 0 Then
If Posi > 1.3 * L Then 'Trennposition zu spät, vorher versuchen
If L > 5 Then 'Länge verkürzen um vorherige Leerstelle zu Nutzen
Z = L - 5 '5=Erfahrungswert!
Else
Z = L
End If
Posi = InStr(Z, strText, " ")
If Posi > 0 Then
If Posi > 1.3 * L Then '1.3 beispielsweise
arrText(I) = Left(strText, L)
strText = Right(strText, TL - L)
Else
arrText(I) = Left(strText, Posi)
strText = Right(strText, TL - Posi)
End If
End If
Else
arrText(I) = Left(strText, Posi)
strText = Right(strText, TL - Posi)
End If
I = I + 1
Else 'Zwangsumbruch, weil kein Trennelement gefunden
arrText(I) = Left(strText, L)
strText = Right(strText, TL - L)
I = I + 1
End If
Else
Ende = True
arrText(I) = strText
End If
Loop Until Ende
'Array-Größe korrigieren
If Trim(arrText(UBound(arrText))) = "" Then
ReDim Preserve arrText(UBound(arrText) - 1)
End If
'meinSplit = WorksheetFunction.Transpose(arrText()) 'Zeilenvektor
meinSplit = arrText() 'Spaltenvektor automatisch!!
End Function
mit einem 295 Zeichen langen Text probiert mit Spaltenbreiten zwischen 5 und 200 Zeichen.
Fehlerbehandlung fehlt.
Mit freundlichen Grüßen
Albrecht