Unlösbar ???

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi Franz,
die Formeln in A3:B3 kannst du nach unten kopieren, die Formeln in Zeile 2 sind anders:

	A	B
2	In eine Zelle D1 wird ein längerer Fließtext eingetragen.	59
3	Dieser soll per VBA bedarfsgerecht auf die Zellen A2 bis	57
4	A20 aufgeteilt werden. Ist der Fliesstext zu lange, solle	58
5	der der Rest notgedrungen dem gleichen Schema ab A21	53
6	eingetragen werden. als weitere Schwierigekit sollen die	57
7	Eingaben Kleiner Zeichen na Größer Zeichen oder Kleiner	56
8	Zeichen nz Größer Zeichen immer alleine in einer Zelle	55
9	stehen. Bekomme die richtigen Zeichen nicht hin. Und die	57
10	Formel kanns auch nicht.	25

Formeln der Tabelle

Zelle	Formel
A2	{=LINKS(D$1;-1+MAX(WENN(TEIL(D$1;ZEILE($1:$60); 1)=" ";ZEILE($1:$60); 1)))}
B2	=LÄNGE(A2)+2
A3	{=TEIL(D$1;SUMME(B$2:B2); MAX(WENN(TEIL(D$1; ZEILE(INDEX(A$1:A$9999;SUMME(B$2:B2)):INDEX(A$1:A$9999;SUMME(B$2:B2)+59)); 1)=" "; ZEILE(INDEX(A$1:A$9999;SUMME(B$2:B2)):INDEX(A$1:A$9999;SUMME(B$2:B2)+59)); 1)) -SUMME(B$2:B2))}
B3	=LÄNGE(A3)+1
A4	{=TEIL(D$1;SUMME(B$2:B3); MAX(WENN(TEIL(D$1; ZEILE(INDEX(A$1:A$9999;SUMME(B$2:B3)):INDEX(A$1:A$9999;SUMME(B$2:B3)+59)); 1)=" "; ZEILE(INDEX(A$1:A$9999;SUMME(B$2:B3)):INDEX(A$1:A$9999;SUMME(B$2:B3)+59)); 1)) -SUMME(B$2:B3))}
B4	=LÄNGE(A4)+1

Enthält Matrixformel:
Umrandende { } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!

Matrix verstehen

@Walter: Die Nr. 326 scheint mir bei dieser Fragestellung nicht wirklich zu helfen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Hallo Franz,
teste mal.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub franz()
  Dim vntText As Variant, strTmp As String
  Dim lngIndex As Long, lngPos As Long, lngC As Long
  Dim strOutput() As String

  Const MAXLEN As Integer = 60 'maximale Textlänge

  With ActiveSheet
    .Columns(1).ClearContents 'Spalte A leeren

    vntText = Split(.Range("D1").Text, " ")

    Do
      If vntText(lngC) Like "<*>" Then
        Redim Preserve strOutput(lngIndex)
        strOutput(lngIndex) = vntText(lngC)
        lngIndex = lngIndex + 1
      Else
        Do While Not vntText(lngC) Like "<*>" And Len(Trim$(strTmp) & vntText(lngC)) <= MAXLEN
          strTmp = strTmp & vntText(lngC) & " "
          lngC = lngC + 1
          If lngC > UBound(vntText) Then Exit Do
        Loop
        If Len(strTmp) Then
          Redim Preserve strOutput(lngIndex)
          strOutput(lngIndex) = Trim$(strTmp)
          lngIndex = lngIndex + 1
          lngC = lngC - 1
        End If
      End If
      lngC = lngC + 1
      strTmp = ""
    Loop While lngC <= UBound(vntText)

    .Range("A1").Resize(UBound(strOutput) + 1, 1) = Application.Transpose(strOutput)
  End With

End Sub

Gruß Sepp

Sub franz2() Dim arrT As Variant, strTmp As String Dim lngE As Long, lngC As Long, lngT As Long Dim strErg() As String Const MAXLEN As Integer = 60 'maximale Textlänge With ActiveSheet .Columns(1).ClearContents 'Spalte A leeren strTmp = .Range("D1").Text strTmp = Replace(Replace(strTmp, Chr(13), " "), Chr(10), " ") arrT = Split(strTmp, " ") ReDim Preserve strErg(UBound(arrT)) For lngC = 0 To UBound(arrT) strTmp = "" If arrT(lngC) Like "" Then strErg(lngE) = arrT(lngC) lngE = lngE + 1 Else lngT = lngC Do While Not arrT(lngT) Like "" And Len(Trim$(strTmp) & arrT(lngT)) UBound(arrT) Then Exit For Loop strErg(lngE) = Trim$(strTmp) lngE = lngE + 1 lngC = lngT - 1 End If Next lngC ReDim Preserve strErg(lngE) If Len(strTmp) Then strErg(lngE) = Trim$(strTmp) lngE = lngE + 1 End If .Cells(1, 1).Resize(UBound(strErg) + 1, 1) = Application.Transpose(strErg) End With End Sub

Beliebteste Forumthreads (12 Monate)

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread