Zelle

Sub TerminEingeben() Dim termf(100) As Date Dim feiert(100) As String On Error Resume Next Worksheets("Tabelle21").Activate z = 3 Do While Cells(z, 18) "" termf(z) = Left(Cells(z, 18), 6) + _ Right(Cells(1, 1), 2) feiert(z) = Cells(z, 19) z = z + 1 Loop For e = 3 To z For T = 3 To Cells(Rows.Count, 1).End(xlUp).Row m = 1 If feiert(e) = "Tag der dt. Einheit" _ And Cells(1, 1) "" Then Cells(T, m + 1).RowHeight = 25 Cells(T, m + 1) = Cells(T, m + 1) _ & Chr(10) & feiert(e) End If Next T Next e End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Forum , Hallo Daniel
Habe das Makro geändert . Habe aber nun das Problem das nicht alle Textreihen in der aktiven Zelle
gleich lang sind.Gibt es die möglichkeit die länge zu überprüfen um dann Start und Länge den
Zelleninhalt anzupassen . Hier das Makro


Sub Termine_eintragen1()
Dim termf(100) As Date
Dim feiert(100) As String
Dim zg As Long, m As Long, z As Long, T As Long
Dim e As Long
z = 3
Do While Cells(z, 18)  ""
termf(z) = Left(Cells(z, 18), 6) + _
Right(Cells(1, 1), 2)
feiert(z) = Cells(z, 19)
z = z + 1
Loop
For e = 3 To z
For T = 3 To Cells(Rows.Count, 1).End(xlUp).Row
m = 1
If feiert(e) = "Tag der dt. Einheit" _
And Cells(1, 1)  "" Then
Cells(T, m + 1).RowHeight = 25
Cells(T, m + 1) = Cells(T, m + 1) _
& Chr(10) & feiert(e)
Cells(T, m + 1).Select
With ActiveCell.Characters(Start:=1, Length:=37).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
With ActiveCell.Characters(Start:=38, Length:=55).Font
.Name = "Arial"
.FontStyle = "Standart"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
End If
Next T
Next e
End Sub

Gruss
Ralf

Hi
kommt darauf an, wo du die Trennung hin haben willst.
vermutlich beim Zeilenumbruch.
die Position des Zeilenwechsels kannst du mit folgender Funktion finden:
instr(Cells(T, m + 1), Chr(10))
und die absolute Länge der Zelle mit dieser:
Len(Cells(T, m + 1))
damit solltest du dir dann den Rest zusammenbasteln können.
btw, das ist Schrott:


Cells(T, m + 1).Select
With ActiveCell.Characters(Start:=1, Length:=37).Font

wenn, dann schreibt man das so:


with Cells(T, m + 1).Characters(Start:=1, Length:=37).Font

du brauchst auch nicht zwingend die ganze Liternai der möglichen Eigenschaften aufführen, nur weil der Recorder das aufzeichnet, es reicht die Eigenschaft,die du ändern willst.
Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread