VBA Wörter farbig makieren

Hallo zusammen,
ich habe eine Frage zu VBA und zwar möchte ich alle Wörter die mit Auftragsnummer und Reklamation in allen Tabellenblättern farblich markieren.
Ich schreibe in Spalte F einen kurzen Text...Heute waren wir beim Kunden xy für die Auftragsnummer(1234). Anschließend verlasse ich die Zelle und die Auftragsnummer + das was in den Klammern steht soll farblich markiert werden.
Wie bekomme ich es hin das ich die Auftragsnummer(1234) in eine andere Farbe hervorheben kann. Ich habe es geschafft das er mir zumindest die Auftragsnummer farbig markiert aber nicht die Nummer in den Klammern dahinter, da die Auftragsnummer ja immer unterschiedlich sein kann. (wobei das auch nicht mehr funktioniert nachdem ich einiges ausprobiert habe^^)
Ich hoffe ihr konntet verstehen was ich meine...
Danke schon einmal für die Hilfe!
LG Verena

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code: [Cc] Private Sub Worksheet_Change(ByVal Target As Range) Dim P1 As Integer, P2 As Integer With Target P1 = InStr(.Value, "(") If P1 > 0 Then P2 = InStr(P1 + 1, .Value, ")") ' Jetzt formatieren If P2 > P1 Then With .Characters(Start:=P1 + 1, Length:=(P2 - P1 - 1)) .Font.Color = RGB(255, 0, 0) End With End If End If End With End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer, Arr, ArrCol Dim P1 As Integer, P2 As Integer Arr = Array("Auftrag(", "Reklamation(") ' zu betrachtende Elemente ArrCol = Array(RGB(255, 0, 0), RGB(0, 255, 0)) ' die jeweilige Farbe If Not Intersect(Target, Columns(6)) Is Nothing Then ' Nur Änderungen in Spalte F 'reset Target.Font.ColorIndex = xlAutomatic For i = LBound(Arr) To UBound(Arr) P1 = InStr(Target, Arr(i)) If P1 > 0 Then P2 = InStr(P1 + 1, Target, ")") + 1 Target.Characters(Start:=P1, Length:=(P2 - P1)).Font.Color = ArrCol(i) End If Next End If End Sub

so...
Die beiden Arrays kannst du durch "Komma" erweitern
Parallel zum Suchwort immer einen passenden Farbwert ergänzen (kann auch der Selbe sein)
Es sollten also immer gleich viele Elemente in den beiden Arrays sein
Das Array Arr wird dann so oft durchlaufen, wie Einträge da sind.
P1 und P2 sind je nach Eintrag immer Anfang und Endpunkt der Färbung


Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, Arr, ArrCol
Dim P1 As Integer, P2 As Integer
Arr = Array("Auftrag", "Reklamation", "Rechnung") ' zu betrachtende Elemente
ArrCol = Array(RGB(255, 0, 0), RGB(0, 176, 80), RGB(0, 0, 255)) ' die jeweilige Farbe
If Not Intersect(Target, Columns(6)) Is Nothing Then ' Nur Änderungen in Spalte F
'reset
Target.Font.ColorIndex = xlAutomatic
For i = LBound(Arr) To UBound(Arr)
P1 = InStr(Target, Arr(i))
If P1 > 0 Then
P2 = InStr(P1 + 1, Target, ")") + 1
Target.Characters(Start:=P1, Length:=(P2 - P1)).Font.Color = ArrCol(i)
End If
Next
End If
End Sub

LG UweD

Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer, Arr Dim P1 As Integer, P2 As Integer Arr = Array("Auftrag(", "Reklamation(") ' zu betrachtende Elemente If Not Intersect(Target, Columns(6)) Is Nothing Then ' Nur Änderungen in Spalte F 'reset Target.Font.ColorIndex = xlAutomatic For i = LBound(Arr) To UBound(Arr) P1 = InStr(Target, Arr(i)) If P1 > 0 Then P1 = P1 + Len(Arr(i)) P2 = InStr(P1 + 1, Target, ")") Target.Characters(Start:=P1, Length:=(P2 - P1)).Font.Color = RGB(255, 0, 0) End If Next End If End Sub

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread