'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr


Sub test()
  'nimm den Inhalt aus Zelle A1 und
  'verteile ihn stückweise auf die Zellen
  'A2,A3,A4 spaltenweise! - beachte wenn möglich
  'Leerzeichen als Trenner im Inhalt von A1
  'und versuche max 15 Zeichen pro Zelle aufzufüllen!
  split_text [A2], [A1].Text, 15, " ", False
End Sub



Sub split_text(zelle As Range, _
               inhalt As String, _
               Optional maxlänge = 10, _
               Optional trenner = " ", _
               Optional zeilenweise = True)

Do While Len(inhalt) > 0
If Len(inhalt) < maxlänge Then
   zelle = inhalt
   inhalt = ""
   Else
   pos1 = InStr(1, inhalt, trenner)
   If pos1 = 0 Then
      zelle = Left(inhalt, maxlänge)
      If Len(inhalt) > maxlänge Then
         inhalt = Right(inhalt, Len(inhalt) - maxlänge)
         setze_neue_zelle zelle, zeilenweise
         Else
         inhalt = ""
         End If
      Else
      If pos1 >= maxlänge Then
         zelle = Left(inhalt, maxlänge)
         inhalt = Right(inhalt, Len(inhalt) - maxlänge)
         setze_neue_zelle zelle, zeilenweise
         pos1 = 0
         End If
      pos2 = pos1
      Do
         pos2 = InStr(pos1 + 1, inhalt, trenner)
         Select Case pos2
            Case 0: pos2 = pos1
            Case Is <= maxlänge: pos1 = pos2: pos2 = 0
            Case Else: pos2 = pos1
            End Select
         Loop Until pos2 = pos1
      If pos1 > 0 Then
         zelle = Left(inhalt, pos1)
         inhalt = Right(inhalt, Len(inhalt) - pos1)
         setze_neue_zelle zelle, zeilenweise
         End If
      End If
    End If
  Loop
End Sub

Private Sub setze_neue_zelle(z As Range, ByVal b As Boolean)
   If b Then
      Set z = z.Offset(0, 1)
      Else
      Set z = z.Offset(1, 0)
      End If
End Sub