AW: Makro: Textsuche in Excel, farblich markieren
21.03.2017 02:27:09
Rainer
Hallo Hokweb,
hier der Code:
Private Sub MARKER()
Dim i, R1, R2, Textlaenge, Nichtsmachen As Integer
Dim Suchttext As String
Dim Textfarbe As Long
For R1 = 6 To 21
If IsEmpty(Range("C" & R1)) = True Then
Nichtsmachen = 1
Else
Suchttext = Range("C" & R1)
Textlaenge = Len(Suchttext)
Textfarbe = Range("C" & R1).Font.Color
For R2 = 23 To 200
i = InStr(Range("D" & R2), Suchttext)
Do While i > 0
Range("D" & R2).Characters(Start:=i, Length:=Textlaenge).Font.Color = Textfarbe
i = InStr(i + Textlaenge, Range("D" & R2), Suchttext)
Loop
i = InStr(Range("E" & R2), Suchttext)
Do While i > 0
Range("E" & R2).Characters(Start:=i, Length:=Textlaenge).Font.Color = Textfarbe
i = InStr(i + Textlaenge, Range("E" & R2), Suchttext)
Loop
i = InStr(Range("F" & R2), Suchttext)
Do While i > 0
Range("F" & R2).Characters(Start:=i, Length:=Textlaenge).Font.Color = Textfarbe
i = InStr(i + Textlaenge, Range("F" & R2), Suchttext)
Loop
Next R2
End If
Next R1
End Sub
Du musst aber beim Eingeben der Begriffe aufpassen, wenn da ein Leerzeichen am Ende steht findet der Code nichts.
Die farbliche Markierung wird entsprechend der Textfarbe in C6:C21 übernommen.
Viele Grüße,
Rainer