Einzelne Zeichen aus Zelle löschen...

Hallo,
ich habe ein kleines Problem.
Ich habe eine Zelle mit Text, aus der ich mittels VBA bestimmte Zeichen löschen muss. Hierbei ist jedoch nicht das Zeichen selbst, sondern die Formatierung des Zeichens ausschlaggebend.
Beispiel:
Eine Zelle enthält überwiegend schwarzen Text, innerhalb des Textes gibt es aber rot-durchgestrichene Wörter. Diese sollen entfernt werden.
Daher arbeite ich mit der Cells.Character-Eigenschaft. Solange die Zelle Text unterhalb von 256 Zeichen beinhaltet funktioniert alles wunderbar, aber ab 257 Zeichen passiert entweder nichts oder, es gibt den Fehler 1004.
Code-Beispiel:

Sub CharDelete()
ChAnz = ActiveCell.Characters.Count
For z = 1 To ChAnz
If ActiveCell.Characters(z, 1).Font.ColorIndex = 3 _
And ActiveCell.Characters(z, 1).Font.Strikethrough = True Then
ActiveCell.Characters(z, 1).Delete
ChAnz = ChAnz - 1
z = z - 1
End If
Next
End Sub

Diese Beschränkung gilt nur die Delete-Funktion, wenn ich statt


ActiveCell.Characters(z, 1).Delete

den Befehl


ActiveCell.Characters(z, 1).Font.Bold = True

verwende, funktioniert es wunderbar auch bei mehr als 256 Zeichen.
Hat jemand eine Idee, wie ich diese Beschränkung umgehen kann. Gern auch ein anderer Lösungsansatz, immer unter Beibehaltung der unterschiedlichen Formatierung des Zell-Textes (Farbe, Form, etc.)
Danke und Gruß
Mirko

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub CharDelete2() Dim ChAnz As Long, Z As Long With ActiveCell ChAnz = .Characters.Count For Z = ChAnz To 1 Step -1 With .Characters(Z, 1) If .Font.ColorIndex = 3 Then If .Font.Strikethrough = True Then .Delete End If End If End With Next End With End Sub

Sub RotDgEntfernen() Dim txt1 As String, txt2 As String Dim i As Long, x As Long '--- zu speichernde Formate Dim FoFarbe() As Long Dim FoFett() As Boolean Dim FoItalic() As Boolean Dim FoSize() As Long txt1 = Zelle.Value With ActiveCell txt1 = .Text ReDim FoFarbe(1 To Len(txt1)) ReDim FoFett(1 To Len(txt1)) ReDim FoItalic(1 To Len(txt1)) ReDim FoSize(1 To Len(txt1)) '--- Format und Text Speichern For i = 1 To Len(txt1) With .Characters(i, 1).Font If .Strikethrough = True And .ColorIndex = 3 Then Else x = x + 1 txt2 = txt2 & .Parent.Text FoFarbe(x) = .ColorIndex FoFett(x) = .Bold FoItalic(x) = .Italic FoSize(x) = .Size End If End With Next '--- neuen Text in Zelle schreiben .Value = txt2 '--- Zeichen formatieren For i = 1 To Len(txt2) With .Characters(i, 1).Font .ColorIndex = FoFarbe(i) .Bold = FoFett(i) .Italic = FoItalic(i) .Size = FoSize(i) End With Next End With End Sub

…Mirko! ;-)
Was heißt weniger performant? Weniger als gar nichts und dafür 'ne Endlosschleife…? ;->
Das folgende Bsp zu erzeugen, hat kaum 'ne Sekunde erfordert, obwohl viel mehr Formatierungensitems abgefragt wurden (das Schreiben des Pgms allerdings wesentlich mehr!):

~~Hallo,~~ ich habe ein kleines Problem. Ich habe eine Zelle mit Text, aus der ich mittels VBA bestimmte Zeichen löschen muss. Hierbei ist jedoch nicht das Zeichen selbst, sondern die Formatierung des Zeichens ausschlaggebend.
Beispiel: Eine Zelle enthält überwiegend schwarzen Text, innerhalb des Textes gibt es aber rot-durchgestrichene Wörter. Diese sollen entfernt werden. Daher arbeite ich mit der Cells.Character-Eigenschaft. Solange die Zelle Text unterhalb von 256 Zeichen beinhaltet, funktioniert alles wunderbar, aber ab 257 Zeichen passiert entweder nichts oder es gibt den Fehler 1004.

Gruß, Luc :-?

Sub CharDelete_2() Dim ChAnz%, z%, tmp$, x$ ChAnz = ActiveCell.Characters.Count x = ActiveCell.Value For z = 1 To ChAnz If ActiveCell.Characters(z, 1).Font.ColorIndex 3 _ And ActiveCell.Characters(z, 1).Font.Strikethrough = False Then tmp = tmp & Mid(x, z, 1) End If Next ActiveCell.Value = tmp End Sub

Beliebteste Forumthreads (12 Monate)

Einzelne Zeichen aus Zelle löschen...

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

330 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Einzelne Zeichen aus Zelle löschen...

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

330 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread