Hallo,
meine aktive Zelle ist auf 42 Zeichen begrenzt und soll bei längeren Texte bei aktivierten Zeilenumbruch
denn Textinhallt auf max. 4 folgenden Zellen aufteilen.
Hab schon überall nach einer Lösung gesucht aber nix mit aufteilen bei Texteingabe finden können.
Würde mich freuen wenn jemand mir hier weiterhelfen könnte..
Danke
Suphi
Hallo, Suphi;
dazu wirst du auch nichts finden, denn das ist keine Xl-Standard-Funktionalität. Auch das Aufteilen mit Text-in-Spalten funktioniert kaum, da du ja, wohl in der Nähe der Maximallänge pro Zelle (sinnvoll) teilen willst. Das geht nur im Nachhinein und mit VBA bzw VBA-gestützten selbstdefinierten Funktionen (UDFs) in einer Zellformel.
Unter
diesem Link kannst du eine Datei runterladen, die u.a. die beiden UDFs TxRows und Splitt enthält, mit denen das in einer Zellformel bewerkstelligt werden kann:
{=Splitt(TxRows(A1;42);Zeichen(10))}
Dabei wird an der letzten sinnvollen Stelle vor der Maximallänge ein Zeilenumbruch eingefügt. Da du ja den Text auf verschiedene Spalten (alle mit max 42 Zeichen Text!) aufteilen willst, musst du zusätzlich Splitt verwenden, das den Text beim Zeilenumbruch teilt. Durch Eingabe der Formel als Matrixformel (durch die nicht miteinzugebenden {} gekennzeichnet) bei vorheriger Auswahl der benötigten Zellen, wird der Text sinnvoll aufgeteilt.
Ist das nicht deine Absicht und der Text soll stets in 42-Zeichen-lange Teilstücke geteilt werden, käme folgende Formel zum Einsatz:
=TEIL($A1;(SPALTE(A1)-1)*42+1;42)
Die kann dann über die benötigten Spalten gezogen werden.
Gruß, Castor
@Castor: Komme mit deiner Anleitung nicht ganz klar, ich will keine Textausgabe aufteillen sondern die Aktuelle Eingabe.
hab diesen VBA Code gefunden,Funktioniert auch soweit ganz gut nur will ich nicht dass er mit das Wort nach 42 Zeichen
in Zwei Teilt. Gibs es eine Funktion wie bei Zeilenumbruch wo das Wort nicht getrennt wird ?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERR_HANDLER
Dim AktiveZeile As Integer
Dim AktiveSpalte As String * 1
Dim Zeichenzahl As Integer
Dim Text As String * 210
AktiveZeile = Target.Row
AktiveSpalte = "B"
Zeichenzahl = Len(Range(AktiveSpalte & (AktiveZeile)).Value)
Text = Range(AktiveSpalte & (AktiveZeile)).Value
If Zeichenzahl > 42 Then
Range(AktiveSpalte & (AktiveZeile + 1)) = Mid(Text, 41)
Range(AktiveSpalte & AktiveZeile) = Left(Text, 40)
End If
ERR_HANDLER:
End Sub
gruss
Suphi
Hallo Suphi,
wo soll denn getrennt werden, wenn ein Wort die Grenze überschreitet? Ich nehme an, am letzten Leerzeichen vor dem 42. Zeichen?
Du könntest z.B. in einer Schleife die Stellen der Leerzeichen des Textes ermitteln und dann entsprechend schneiden.
Oder Du splittest den Text an den Leerzeichen und setzt ihn dann wieder zusammen:
im Prinzip so:
strTemp=Split(Text, " ")
for i=lbound(strtemp) to ubound(strTemp)
if len(strText) + len(strTemp(i)) < 42 then strText=strText & " " & strTemp(i)
Next
Das wäre jetzt nur die erste Zeile, musst also noch etwas dran schrauben.
Was du da eingestellt hast, Suphi,
ist eine Ereignisprozedur. Die reagiert auch nicht
während der Eingabe, sondern erst nach deren Abschluss. Statt nun ein komplettes Programm in diese Prozedur zu stecken, solltest du sie als Verteiler benutzen, denn du hast nur
eine _Change-Prozedur pro Blatt, eine pro Mappe und eine für Xl insgesamt.
Statt eines Verteilers kannst du im Relevanzfall auch mit Funktionsaufrufen arbeiten:
Code:
Const maxTTxtLg As Long = 42
Dim zwErg As Variant
...
If Len(Target) > maxTTxtLg Then
zwErg = Split(TxRows(Target, maxTTxtLg), vbLf)
Target.Resize(1, UBound(zwErg) + 1) = zwErg
End If
...
Die UDF
TxRows reagiert übrigens nicht nur auf Leer-, sondern noch eine Reihe anderer Satzzeichen. Der Originaltext wird hier überschrieben.
Übrigens, nicht das zeitweilige Sperren von Ereignisreaktionen (
Application.EnableEvents = False/True bei Eintreten des Relevanzfalles (und nach Abschluss) vergessen, sonst ruft sich die Prozedur endlos selbst auf, da diese Aktion selbstverständlich ebenfalls eine Änderung ist.
Gruß, Castor
@ Castor : bekomme immer sub oder function nicht definiert fehler meldung angezeigt,was mache ich falsch !?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERR_HANDLER
Const maxTTxtLg As Long = 42
Dim zwErg As Variant
If Len(Target) > maxTTxtLg Then
zwErg = Split(TxRows(Target, maxTTxtLg), vbLf)
Target.Resize(1, UBound(zwErg) + 1) = zwErg
End If
ERR_HANDLER:
End Sub
@schauan: kenne mich mit VBA so gut wie null aus weiss nicht wie ich dein Code vervollständingen soll ?
gruss
Suphi
Du hast meinen Hinweis auf
Application.EnableEvents = False bzw
True nicht beachtet, Suphi,
und insofern Glück gehabt, dass du offensichtlich vergessen hast dem Link in meiner 1.Antwort zu folgen und den ProgrammCode der UDF
TxRows in dein VBA-Projekt zu übernehmen.
Sich mit VBA nicht auszukennen ist keine Entschuldigung für jemanden, der VBA anwenden will, nur sträflicher Leichtsinn, besonders bei Ereignisprozeduren. :-|
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const maxTTxtLg As Long = 42, adRelBer$ = "A1:A10" '<-- anpassen!
Dim zwErg As Variant
If Not Intersect(Target, Me.Range(adRelBer)) Is Nothing Then
If Len(Target) > maxTTxtLg Then
With Application
.EnableEvents = False
zwErg = Split(TxRows(Target, maxTTxtLg), vbLf)
Target.Resize(1, UBound(zwErg) + 1) = zwErg
.EnableEvents = True
End With
End If
End If
End Sub
Die Ereignisprozedur muss im Dokument-Klassenmodul der jeweiligen Tabelle des VBA-Projekts deiner Datei angelegt werden. Die UDF muss in ein extra anzulegendes (allgemeines, nicht Klassen-)Modul des Projektes kopiert werden, falls du sie im ganzen Projekt (evtl auch in Zellformeln) benutzen willst. Ansonsten könnte sie auch ins gleiche Modul wie die obenstehende Ereignisprozedur.
Castor
danke funktioniert jetzt wie es soll :)
gruss
Suphi