Wort oder Zahl färben

Guten Tag VBAler/innen,
mit dem folgenden Makro wird in Tabelle1 das Wort "Sub" rot gefärbt und das funktioniert perfekt (ist aber nicht von mir ...).
Wie muss das Makro sein, wenn das Suchwort per Input abgefragt wird und die Länge des Wortes - könnte auch eine Zahl sein - unabhängige Länge hat?
Wäre schön, wenn es eine Lösung gäbe.
Gruß, Dieter(Drummer)


Sub ZeichenFettUndRot()
Dim rng As Range, n&
On Error Resume Next
MsgBox "Please wait ...", "Mx Info", 64
Application.ScreenUpdating = False
For Each rng In Sheets("Tabelle1").UsedRange 'Tabelle/Bereich evtl. anpassen
If Not rng.HasFormula Then
For n = 1 To Len(rng.Value) 'Mx: 1 = erster gesuchter Buchstabe (s. Text)
If rng.Characters(Start:=n, Length:=3).Text = "Sub" Then 'Mx: 3 = Textlänge = "Sub" = 3  _
Buchstaben
'rng.Characters(Start:=n + 1, Length:=1).Font.Bold = True
rng.Characters(Start:=n + 0, Length:=3).Font.Color = vbRed 'Mx: 3 = Buchstabenmenge, die  _
rot wird
Exit For
End If
Next n
End If
Next rng
Application.ScreenUpdating = True
MsgBox "Fertig", 64
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ZeichenFettUndRot() Dim rng As Range, n& Dim sEingabe As String On Error Resume Next sEingabe = InputBox("Bitte Suchwort eingeben") If sEingabe = "" Then Exit Sub MsgBox "Please wait ...", "Mx Info", 64 Application.ScreenUpdating = False For Each rng In Sheets("Tabelle1").UsedRange If Not rng.HasFormula Then For n = 1 To Len(rng.Value) If rng.Characters(Start:=n, Length:=Len(sEingabe)).Text = sEingabe Then rng.Characters(Start:=n + 0, Length:=Len(sEingabe)).Font.Color = vbRed Exit For End If Next n End If Next rng Application.ScreenUpdating = True MsgBox "Fertig", 64 End Sub

Sub ZeichenFettUndRot() Dim rng As Range, n& Dim SuchTxt As String On Error Resume Next MsgBox "Please wait ...", "Mx Info", 64 Application.ScreenUpdating = False SuchTxt = InputBox("Suchwort", "Fett und Rot..") For Each rng In Sheets("Tabelle1").UsedRange 'Tabelle/Bereich evtl. anpassen If Not rng.HasFormula Then For n = 1 To Len(rng.Value) 'Mx: 1 = erster gesuchter Buchstabe (s. Text) If rng.Characters(Start:=n, Length:=Len(SuchTxt)).Text = SuchTxt Then 'rng.Characters(Start:=n + 1, Length:=1).Font.Bold = True rng.Characters(Start:=n + 0, Length:=Len(SuchTxt)).Font.Color = vbRed Exit For End If Next n End If Next rng Application.ScreenUpdating = True MsgBox "Fertig", 64 End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wort oder Zahl färben

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread