Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
976to980
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
976to980
976to980
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Automatischer Zeilenumsprung - auf mehrere Zellen?

Automatischer Zeilenumsprung - auf mehrere Zellen?
20.05.2008 09:22:32
Gerhard
Hallo zusammen...
Habe gestern folgenden Code erhalten, der mir automatisch meinen Text nach 100 Zeichen trennt und in eine neue darunterliegende Zelle schreibt.

Private Sub Worksheet_Change(ByVal Target As Range)
Const MaxZeichen As Long = 100
Const TrKZ As String = " "
Dim Txt As String, Txt1 As String, Txt2 As String
Dim Pos As Long
if Intersect(Target, Range("L28:L500, D28:D500, C28:C500")) is nothing then exit sub
If Target.Cells.Count > 1 Then Exit Sub
Txt = Target.Text
If Len(Txt) 


In dieser Zeile kann ich ja mehrere Spalten ansprechen:
if Intersect(Target, Range("L28:L500, D28:D500,C28:C500")) is nothing then exit sub
Ist es möglich das alles so umzuschreiben, das ich bei verschiedenen Spalten verschiedene Werte angeben kann? Im Moment isses ja so, das bei den drei Spalten nach 100 Zeichen ein Umbruch erfolgt.
In Spalte D benötige ich 32 Zeichen, in L 15 und in C sind es 60 Zeichen.
Kann mir hierbei jemand behilflich sein, das so umzuschreiben?
LG Gerhard

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatischer Zeilenumsprung - auf mehrere Zel
20.05.2008 09:42:00
Matthias
Hallo
nicht getestet !

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const MaxZeichen_L As Long = 100
Const MaxZeichen_C As Long = 500
Const MaxZeichen_D As Long = 700
Const TrKZ As String = " "
Dim Txt As String, Txt1 As String, Txt2 As String
Dim Pos As Long
If Not Intersect(Target, Range("L28:L500")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
Txt = Target.Text
If Len(Txt) L Then Exit Sub
If InStr(Txt, TrKZ) = 0 Then Exit Sub
Pos = InStrRev(Txt, TrKZ, MaxZeichen_L + 1)
If Pos = 0 Then Pos = InStr(Txt, TrKZ)
Txt1 = Left(Txt, Pos - 1)
Txt2 = Mid(Txt, Pos + 1)
Target.Offset(1, 0).EntireRow.Insert
Target.Value = Txt1
Target.Offset(1, 0).Value = Txt2
End If
If Not Intersect(Target, Range("D28:D500")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
Txt = Target.Text
If Len(Txt) D Then Exit Sub
If InStr(Txt, TrKZ) = 0 Then Exit Sub
Pos = InStrRev(Txt, TrKZ, MaxZeichen_D + 1)
If Pos = 0 Then Pos = InStr(Txt, TrKZ)
Txt1 = Left(Txt, Pos - 1)
Txt2 = Mid(Txt, Pos + 1)
Target.Offset(1, 0).EntireRow.Insert
Target.Value = Txt1
Target.Offset(1, 0).Value = Txt2
End If
If Not Intersect(Target, Range("C28:C500")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
Txt = Target.Text
If Len(Txt) C Then Exit Sub
If InStr(Txt, TrKZ) = 0 Then Exit Sub
Pos = InStrRev(Txt, TrKZ, MaxZeichen_C + 1)
If Pos = 0 Then Pos = InStr(Txt, TrKZ)
Txt1 = Left(Txt, Pos - 1)
Txt2 = Mid(Txt, Pos + 1)
Target.Offset(1, 0).EntireRow.Insert
Target.Value = Txt1
Target.Offset(1, 0).Value = Txt2
End If
End Sub


Gruß Matthias

Anzeige
Funktioniert !!! Danke!!!!
20.05.2008 09:47:06
Gerhard
Wow dat ging fix und funktioniert!!!!
Danke Matthias!!!!

AW: Automatischer Zeilenumsprung - auf mehrere Zel
21.05.2008 01:03:00
Daniel
Hi
das ist aber etwas umständlich, so gehts einfacher:

Private Sub Worksheet_Change(ByVal Target As Range)
Const TrKZ As String = " "
Dim Txt As String, Txt1 As String, Txt2 As String
Dim Pos As Long
Dim MaxZeichen As Long
If Intersect(Target, Range("L28:L500, D28:D500, C28:C500")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
 Select Case Target.Column
Case 3
MaxZeichen = 60
Case 4
MaxZeichen = 32
Case 12
MaxZeichen = 15
End Select
Txt = Target.Text
If Len(Txt) 


Gruß, Daniel

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige