Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
2004to2008
2004to2008
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Anzeige
Inhaltsverzeichnis

Spalte auf Textlänge überprüfen & statt Umbruch, neue Zeile

Forumthread: Spalte auf Textlänge überprüfen & statt Umbruch, neue Zeile

Spalte auf Textlänge überprüfen & statt Umbruch, neue Zeile
20.02.2025 19:58:15
Tobi_84
Hallo zusammen,

ich möchte die Zellen in Spalte D (D3) vor der Textlänge 15 Zeichen,
auf eine neu eingefügte Zeile umbrechen und keinen Zeilenumbruch innerhalb der Zelle vornehmen.
Leerzellen sollen ignoriert werden. 



Sub TrennenNachXZeichen()



Dim Wort As String

Dim Cut As Integer

Dim i As Integer

Dim Wörter

Dim Zeile()

Dim a

Cut = 15



Wort = Cells(3, 4).Value

Wort = Application.WorksheetFunction.Substitute(Wort, vbLf, " ")



    'trennen davor

    ReDim Zeile(0)

    a = 0

    Wörter = Split(Wort, " ")

    Zeile(0) = Wörter(0)

    

    For i = 0 To UBound(Wörter) - 1

        If Len(Zeile(a)) + Len(Wörter(i + 1)) > Cut Then

            a = a + 1

            ReDim Preserve Zeile(a)

            Zeile(a) = Wörter(i + 1)

        Else

            Zeile(a) = Zeile(a) & " " & Wörter(i + 1)

        End If

    Next i

    

    Cells(1, 4) = Join(Zeile, vbCrLf)

    

End Sub
Anzeige

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Zeile
20.02.2025 23:03:39
Onur
UND? Wo ist jetzt das Problem oder die Frage ???
Ausserdem:
Wozu "Application.WorksheetFunction.Substitute" ? Es gibt den Replace-Befehl von VBA.
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Zeile
21.02.2025 01:45:22
Kuwer
Hallo Tobi,

ersetze 
    Cells(1, 4) = Join(Zeile, vbCrLf)

durch 
    Rows(2).Resize(UBound(Zeile)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Zeile = Application.Transpose(Zeile)

    Cells(1, 4).Resize(UBound(Zeile)).Value = Zeile


Gruß, Uwe
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
22.02.2025 09:38:20
Tobi_84
Moin Uwe,

danke, für die Unterstützung.
Es funktioniert leider nur für die erste Zelle, und wenn in der Spalte leere Zellen sind läuft der Code in einen Fehler.

Der Fehler liegt an der Schleife, ich selbst komm aber mit meinem Wissen nicht weiter.

Fehler Leerzellen:
Zeile(0) = Wörter(0) verursacht den Fehler

Hier ist nochmal der überarbeitete Code:

Gruß Tobias 
Sub TrennenNachXZeichen()



Dim Wort As String

Dim Cut As Integer

Dim i As Integer

Dim Wörter

Dim Zeile()

Dim a

Cut = 15



Wort = Cells(3, 4).Value

Wort = Application.WorksheetFunction.Substitute(Wort, vbLf, " ")



    'trennen davor

    ReDim Zeile(0)

    a = 0

    Wörter = Split(Wort, " ")

    Zeile(0) = Wörter(0)

    

    For i = 0 To UBound(Wörter) - 1

        If Len(Zeile(a)) + Len(Wörter(i + 1)) > Cut Then

            a = a + 1

            ReDim Preserve Zeile(a)

            Zeile(a) = Wörter(i + 1)

        Else

            Zeile(a) = Zeile(a) & " " & Wörter(i + 1)

        End If

    Next i

    

    Rows(4).Resize(UBound(Zeile)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Zeile = Application.Transpose(Zeile)

    Cells(3, 4).Resize(UBound(Zeile)).Value = Zeile

    

End Sub
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
22.02.2025 19:52:21
Kuwer
Hallo Tobias,

Dein Code war ja auch nur für eine Zelle programmiert. Habe es erweitert für alle Zellen einer Spalte (hier 4 für D) inklusive Berücksichtigung leerer Zellen: 

Sub TrennenNachXZeichen_Kuwer()

  Const lngCut As Long = 15

  Dim a As Long

  Dim i As Long

  Dim lngZ As Long

  Dim vWoerter As Variant

  Dim vZeile() As Variant



  For lngZ = Cells(Rows.Count, 4).End(xlUp).Row To 3 Step -1

    vWoerter = Split(Application.Substitute(Cells(lngZ, 4).Value, vbLf, " "), " ")

    If UBound(vWoerter) > -1 Then

      ReDim vZeile(0)

      a = 0

      vZeile(0) = vWoerter(0)

      

      For i = 0 To UBound(vWoerter) - 1

          If Len(vZeile(a)) + Len(vWoerter(i + 1)) > lngCut Then

              a = a + 1

              ReDim Preserve vZeile(a)

              vZeile(a) = vWoerter(i + 1)

          Else

              vZeile(a) = vZeile(a) & " " & vWoerter(i + 1)

          End If

      Next i

      

      If UBound(vZeile) > 0 Then

        Rows(lngZ + 1).Resize(UBound(vZeile)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        vZeile = Application.Transpose(vZeile)

        Cells(lngZ, 4).Resize(UBound(vZeile)).Value = vZeile

      End If

    End If

  Next lngZ

End Sub

Gruß, Uwe
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
22.02.2025 20:04:52
Tobi_84
Hallo Uwe,

es ist immer wieder erstaunlich wie ihr so etwas hinbekommt.

Vielen Dank.

Gruß Tobias :-)
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
23.02.2025 09:46:38
Tobi_84
Hallo,

wie kann ich in dem Code eine Längenumschaltung einbauen?

Mein Versuch ist leider ohne Erfolg "Mehrfach deklaration im aktuellen Bereich".

Bevor der Text in Spalte 4 eingekürzt wird, möchte ich Spalte 4 nach der Größe abfragen.

Gruß Tobias 

If Cells(lngZ, 8).Value = "26x52" Then

    Const lngCut As Long = 13

ElseIf Cells(lngZ, 8).Value = "37x44" Then

    Const lngCut As Long = 8

ElseIf Cells(lngZ, 8).Value = "26x140" Then

    Const lngCut As Long = 20

End If
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
23.02.2025 12:37:48
Kuwer
Hallo Tobias,

Konstanten sind nicht mehr änderbar, deshalb wieder als "normale" Variable: 

Sub TrennenNachXZeichen_2_Kuwer()

  Dim a As Long, i As Long

  Dim lngCut As Long, lngZ As Long

  Dim vWoerter As Variant, vZeile() As Variant



  For lngZ = Cells(Rows.Count, 4).End(xlUp).Row To 3 Step -1

    vWoerter = Split(Application.Substitute(Cells(lngZ, 4).Value, vbLf, " "), " ")

    If UBound(vWoerter) > -1 Then

      ReDim vZeile(0)

      a = 0

      vZeile(0) = vWoerter(0)

      Select Case Cells(lngZ, 8).Value

        Case Is = "26x52"

          lngCut = 13

        Case Is = "37x44"

          lngCut = 8

        Case Is = "26x140"

          lngCut = 20

        Case Else 'wenn keines der anderen zutrifft

          lngCut = 15

      End Select

      For i = 0 To UBound(vWoerter) - 1

        If Len(vZeile(a)) + Len(vWoerter(i + 1)) > lngCut Then

          a = a + 1

          ReDim Preserve vZeile(a)

          vZeile(a) = vWoerter(i + 1)

        Else

          vZeile(a) = vZeile(a) & " " & vWoerter(i + 1)

        End If

      Next i

      If UBound(vZeile) > 0 Then

        Rows(lngZ + 1).Resize(UBound(vZeile)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        vZeile = Application.Transpose(vZeile)

        Cells(lngZ, 4).Resize(UBound(vZeile)).Value = vZeile

      End If

    End If

  Next lngZ

End Sub

Gruß, Uwe
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
23.02.2025 19:29:12
Tobi_84
Hallo mal wieder,

das mit dem "Select Case" gefällt mir, ich möchte das jetzt auch noch weiter führen, komm aber mal wieder nicht weiter.
Folgende Situation, je nach "Case" möchte ich gern Zellwerte wiederholt befüllen.
Nur leider weiß ich nicht, als was ich "Dim CharBMK As ?, CharSze As ?" deklarieren muss damit es funktioniert.
Oder ich mach etwas anderes falsch.

Gruß Tobias 



Dim anzahlGESAMT As Long, Anzahl As Long

Dim cell As Range, adr5 As Range, rws As Range

Dim anzahlGESAMT As Long, Anzahl As Long





    ' Tabelle auszählen

        Set adr5 = Worksheets("EplSheet").Range("G2:G500" & Cells(Rows.Count, 1).End(xlUp).Row)

        anzahlGESAMT = Application.WorksheetFunction.CountA(adr5)





  With Worksheets("Druck")

        For i = 0 To anzahlGESAMT - 1 ' x beliebige Wierderholung in 1er Reihenschritten

       

        ' Schildergröße: Druck Spalte H(8) aus EplSheet Spalte K(11) einlesen

            .Cells(1 + i, 8).Value = Worksheets("EplSheet").Cells(2 + i, 11).Value

        

        

'        Dim CharBMK As ?, CharSze As ?

        Select Case Cells(anzahlGESAMT, 8).Value

       

       '-------------------

        Case Is = "26x52"

          CharBMK = Chr(10) _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 8).Value

          

          CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + "3|" _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value    

       '-------------------

        Case Is = "37x52"

          CharBMK = Chr(10) _

                  + Chr(10) _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 8).Value

          

          CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + "3|" _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value

       '-------------------

       'etc



        Case Else 'wenn keines der anderen zutrifft

          CharBMK = Chr(10) _

                  + Chr(10) _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 8).Value

          

          CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value _

                  + Chr(10) _

                  + "3|" _

                  + Worksheets("EplSheet").Cells(2 + i, 9).Value

      

      End Select



        ' BMK: Druck Spalte C(3) aus EplSheet Spalte H(8) einlesen

            .Cells(1 + i, 3).Value = CharBMK

        ' Schriftgröße Druck Spalte F(6) aus EplSheet Spalte I(9) einlesen

            .Cells(1 + i, 6).Value = CharSze



        Next i

'.

'.

   End With

End Sub
Anzeige
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
23.02.2025 19:35:24
Uduuh
Hallo,
Strings werden in VBA mit & verknüpft und nicht mit +.

Gruß aus'm Pott
Udo
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
23.02.2025 20:41:21
Tobi_84
Danke, hat sich erledigt, habe meinen Fehler gefunden.

Gruß Tobias
AW: Problem mit Schleife und Select Case
24.02.2025 07:54:47
Tobi_84
Moin,

wenn man denkt man hat ein Problem gelöst und man etwas funktionierendes wieder kaputt macht...
Für die "anzahlGESAMT"-Schleife wollte ich lediglich die "Select Case" Abfrage einbauen, bin aber kläglich gescheitert.
Kann bitte jemand helfen.

Gruß Tobias 



Dim EinzelneWorte() As String, Text As String

Dim i As Integer, lastRow As Integer, intRow As Integer, intLastRow As Integer

Dim cell As Range, adr5 As Range, adr4 As Range, rws As Range

Dim anzahlGESAMT As Long, Anzahl As Long, GESAMT As Long





' Tabelle auszählen

    Set adr5 = Worksheets("EplSheet").Range("G2:G500" & Cells(Rows.Count, 1).End(xlUp).Row)

    anzahlGESAMT = Application.WorksheetFunction.CountA(adr5)





' Tabelle auszählen '(?) Versuch für die "Select Case" Schleife

    Set adr6 = Worksheets("EplSheet").Range("K2:K500" & Cells(Rows.Count, 1).End(xlUp).Row)

    GESAMT = Application.WorksheetFunction.CountA(adr6)





    'ausser dem Lesen von Werten passiert alles auf dem Blatt "Druck"

        With Worksheets("Druck")

        

            .Range("B1:B100").ClearContents

            .Range("B1:B100") = "0"

            

            

        For GESAMT = Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1 '(?)

          

            Dim CharBMK As String, CharSze As String

            Select Case Cells(GESAMT, 8).Value '(?)

           

           '-------------------

            Case Is = "26x52"

              CharBMK = Chr(10) _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 8).Value

              

              CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & "3|" _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value

                        

            Case Is = "37x52"

              CharBMK = Chr(10) _

                      & Chr(10) _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 8).Value

              

              CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & "3|" _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value

           '-------------------

           'etc

    

            Case Else 'wenn keines der anderen zutrifft

              CharBMK = Chr(10) _

                      & Chr(10) _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 8).Value

              

              CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value _

                      & Chr(10) _

                      & "3|" _

                      & Worksheets("EplSheet").Cells(2 + i, 9).Value

            End Select

        Next GESAMT '(?)

        



        For i = 0 To anzahlGESAMT - 1 ' x beliebige Wierderholung in 1er Reihenschritten

        

        ' BMK: Druck Spalte C(3) aus EplSheet Spalte H(8) einlesen

            .Cells(1 + i, 3).Value = CharBMK



        ' Schriftgröße Druck Spalte F(6) aus EplSheet Spalte I(9) einlesen

            .Cells(1 + i, 6).Value = CharSze

        Next i



End Sub
Anzeige
AW: Problem mit Schleife und Select Case
24.02.2025 13:18:46
Tobi_84
Hallo Uwe,

mit dem "Next GESAMT" nach "Next i" hab ich auch schon probiert, leider geht dann der Select Case nicht mehr.

Gruß Tobias.
Anzeige
vielleicht solltest du ...
24.02.2025 22:44:08
Uduuh
Hallo,
(endlich mal) eine Beispieldatei mit Wunschergebnis hochladen.

Gruß aus'm Pott
Udo
AW: Problem mit Schleife und Select Case
24.02.2025 23:02:49
Kuwer
Hllo Tobias,

ich meinte eher das fehlende 

End With
Gruß, Uwe
AW: Problem mit Schleife und Select Case
25.02.2025 07:43:09
Tobi_84
Moin Uwe,
sorry, Asche auf mein Haupt, ich habe nur einen Ausschnitt vom Code gepostet weil der Rest funktioniert und dann nur End Sub eingefügt.
Wäre schön gewesen wenn es nur daran gelegen hätte, ich habe das Ganze jetzt aber anders gelöst.
Danke für die Unterstützung.
Gruß Tobias
Anzeige
AW: vielleicht solltest du ...
24.02.2025 22:50:41
Tobi_84
Hallo Udo,

ich hab jetzt auf Select Case verzichtet und dafür eine If-Anweisung mit Else-If in meine For Schleife eingebaut.

Schönen Abend noch
Gruß Tobias

Forumthreads zu verwandten Themen

Leere Zeilen in einer Zelle entfetfernen
Jockel
Hallo
habe eine Excel Tabelle bekommen in der in einer Spalte Kommentare eingetragen sind.
Die Struktur der Kommentare sollte eigentlich so sein:

Zeileneintrag + Zeilenumbruch
Zeileneintrag ....

also so:
01.01.2022 Eintrag1
01.01.2022 Eintrag2
01.01.2022 E...
30.09.2022 21:12:24
Thread-ID: 1901279
6 Beiträge
Excel VBA, einen Wert setzten?
Peter

Hallo zusammen,
ich benötige bitte Unterstützung:
Ich habe ein VBA welches auch sauber funktioniert, damit erstelle ich Dienstpläne
Nun soll aber oben in der Liste also Z.B.Zelle B7 die Personalnummer rein und zwar nur einmal? Die Nummer steht immer in der Spalte J. Die soll sich na...
25.02.2019 16:12:37
Thread-ID: 1677722
4 Beiträge
Anzeige
Zeilenumbruch in TextBox bringt Fehler in Zelle
Rainer

Hallo,wenn ich in einer TextBox einen mehrzeiligen Text eingebe (mit Shift+Enter) und mit
Range("Form!F5").Value = TextBox.Value an die Tabelle übergebe, dann erhalte ich immer ein kleines Kästchen vor dem Umbruch. Ich müsste das umgehen. Es gab wohl eine Lösung mit Leerzeichen, aber die bri...
11.12.2002 12:23:16
Thread-ID: 191662
12 Beiträge
Anzeige
Excel-Zelleninhalt nach Word übertragen mit Umbruc
Christian

Hallo Excel-Freunde,
nach einer längeren Suche und ergebnislosen Überlegungsphase möchte ich meine Frage gern bei euch los werden. Vielleicht kann mir jemand helfen.
Aktuell schreibe ich an einer Exceltabelle, welche Daten automatisch in ein Word-Formular überträgt. Das klappte bisher a...
06.05.2014 14:04:38
Thread-ID: 1359986
1 Beitrag
Text aus mehreren Zellen anhand eines Kriteriums verketten
Leo17
Hallo zusammen,

ich habe in Zeile 1 x viele Attribute und in Spalte A y viele Objekte (beginnend in A2).

Nicht jedes Objekt hat für jedes Attribut einen Wert. Ist zu einem Objekt kein Wert vorhanden, steht in der entsprechenden Zelle 0.

Ich möchte nun für jedes Objekt eine...
21.08.2024 18:54:46
Thread-ID: 1988876
4 Beiträge
Zeilenumbruch Problem
Florian

Hallo liebe Excel Profis!
Ich habe ein unangenemes Problem! Ich denke, dass es die meisten von euch schon kennen:
Ich habe eine Zeile in der ziemlich viel Text steht (versuchsweise habe ich die Zelle voll gefüllt, also 32767 Zeichen). Nun habe ich über Zelle formatieren, den automatisch...
20.07.2006 13:43:54
Thread-ID: 783923
2 Beiträge
Anzeige
zeilen zusammenfassen zu einer zeile mit umbruch?
stefan

hallo,
ich habe in 3 zellen untereinander einen zusammengehördenden text.
diesen würde ich gern in eine zelle mit zeilenumbruch zusammenfassen.
gibts da ne möglichkeit (ausser copy&paste)?
danke euch
22.03.2006 13:13:44
Thread-ID: 747172
1 Beitrag
Hilfe Seitenumbruch
Lothar

Hallo Leute,
Ich möchte das Formular (Sheet)
bei einem Zeilenumbruch überwachen. Ich möcht gerne mein Problem einmal beschreiben.
Ich habe wie Sie wissen, mir ein Formular erstellt,
das folgende Spalten beinhaltet.Spalte: A B C D E F G freie Spalte für Hilfeinträge
26.06.2002 12:46:28
Thread-ID: 131479
1 Beitrag
ZSeitenübersicht
Hiecke Lothar

Hallo,
Ich möcht gerne mein Problem einmal beschreiben.
Ich habe mir ein Formular erstellt, das folgende Spalten beinhaltet.Spalte: A B C D E F G freie Spalte für Hilfeinträge
Zeile5: Pos Menge Stck Text EP GP erstellt.Da in SpalteD auch Zeilenümbrüche stattfinden, wird...
28.05.2002 18:42:46
Thread-ID: 124335
1 Beitrag
Excel Zellinhalt via VBA kopieren
Dominic

Hallo zusammen,
zunächst zum Hintergrund, zum besseren Verständnis:
Aus einer ziemlich konfusen Datenbankdatei habe ich meine benötigten Daten exportiert.
Artikelstammdaten (Artikel Nr. & Produktbezeichnungen in mehreren Sprachen).
Nun habe ich den Fall, dass innerhalb der...
22.10.2015 13:20:34
Thread-ID: 1453751
2 Beiträge
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
Zeichen ausblenden
14.05.2026 09:50:42
Makro für MacOs
13.05.2026 19:14:18
Gleichheitszeichen
13.05.2026 14:24:56
VBA Projekt Passwort automatisch eingeben
13.05.2026 08:49:41
Reale Berechnung ohne Nachkommawerte
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum