verschiedene Farbformate in einer Zelle

Gabriele · 2007-03-29T14:01:00+00:00

Hallo, ich möchte innerhalb einer Zelle Zeichen in verschiedene Farben darstellen, dies ist händisch auch kein Problem. Nun möchte ich aber vorgegebene Zeichenfolgen mit der Suche/Ersetze - Funktion in verschiedenen Farben darstellen. Beispiel suche alle "-innen-" in der Tabelle und ersetze (in rot) "-aussen-". Es sollen aber nicht alle Zeichen der ganze Zelle rot abgebildet werden, sondern nur die von mir vorgegebenen. Danke

Hallo,
nette Aufgabe. Mal was abseits vom Standard.


Sub Replace_mit_Farben()
Dim rngFind As Range, rngFirst As Range
Dim strFind As String, strReplace As String
Dim intFind As Integer, intReplace As Integer
Dim vntColors(), intX As Integer, intCounter As Integer
strFind = "innen"     'anpassen
strReplace = "aussen"  'anpassen
intFind = Len(strFind)
intReplace = Len(strReplace)
Set rngFind = Cells.Find(What:=strFind, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rngFind Is Nothing Then
Set rngFirst = rngFind
Do
Set rngFind = Cells.FindNext(After:=rngFind)
'Farben merken
intX = InStr(rngFind, strFind)
ReDim vntColors _
(1 To WorksheetFunction.Max(Len(rngFind), Len(rngFind) - strFind + strReplace))
For intCounter = 1 To intX - 1
vntColors(intCounter) = rngFind.Characters(intCounter, 1).Font.ColorIndex
Next intCounter
For intCounter = intX To intX + intReplace - 1
vntColors(intCounter) = 3
Next intCounter
For intCounter = intX + intReplace To UBound(vntColors)
vntColors(intCounter) = _
rngFind.Characters(intCounter + intFind - intReplace, 1).Font.ColorIndex
Next intCounter
'ersetzen
rngFind = Replace(rngFind, strFind, strReplace)
'Farben schreiben
For intCounter = 1 To UBound(vntColors)
rngFind.Characters(intCounter, 1).Font.ColorIndex = vntColors(intCounter)
Next intCounter
Loop Until rngFind.Address = rngFirst.Address
End If
End Sub

Gruß ausm Pott
Udo

Hallo,
da hat Udo wohl nicht richtig getestet. So klappt es:


Sub Replace_mit_Farben()
Dim rngFind As Range, rngFirst As Range
Dim strFind As String, strReplace As String
Dim intFind As Integer, intReplace As Integer
Dim vntColors(), intX As Integer, intCounter As Integer
strFind = "innen"     'anpassen
strReplace = "aussen"  'anpassen
intFind = Len(strFind)
intReplace = Len(strReplace)
Set rngFind = Cells.Find(What:=strFind, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rngFind Is Nothing Then
Set rngFirst = rngFind
Do
Set rngFind = Cells.FindNext(After:=rngFind)
'Farben merken
intX = InStr(rngFind, strFind)
ReDim vntColors _
(1 To WorksheetFunction.Max(Len(rngFind), Len(rngFind) - intFind + intReplace))
For intCounter = 1 To intX - 1
vntColors(intCounter) = rngFind.Characters(intCounter, 1).Font.ColorIndex
Next intCounter
For intCounter = intX To intX + intReplace - 1
vntColors(intCounter) = 3
Next intCounter
For intCounter = intX + intReplace To UBound(vntColors)
vntColors(intCounter) = _
rngFind.Characters(intCounter + intFind - intReplace, 1).Font.ColorIndex
Next intCounter
'ersetzen
rngFind = Replace(rngFind, strFind, strReplace)
'Farben schreiben
For intCounter = 1 To UBound(vntColors)
rngFind.Characters(intCounter, 1).Font.ColorIndex = vntColors(intCounter)
Next intCounter
Loop Until rngFind.Address = rngFirst.Address
End If
End Sub

Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

verschiedene Farbformate in einer Zelle

Forumthread: verschiedene Farbformate in einer Zelle

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

verschiedene Farbformate in einer Zelle

Forumthread: verschiedene Farbformate in einer Zelle

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread