Makro anpassen
mehmet
das Makro funktioniert echt gut.
Allesding werden nur die ersten Fundstellen markiert.
Weitere und folgende (gleiche) fundstellen werden nicht markiert.
Wie könnte man diese anpassen?
Private Sub Markiere_BR_SN_FG_TS_etc()
Sheets("WX").Select
Dim Bereich As Range
Dim objRegEx As Object, objMatch As Object
Dim i As Integer
Dim LRow As Long
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.IgnoreCase = True 'Groß u. Kleinschreibung nicht beachten, sonst False
.MultiLine = True
.Global = True
.Pattern = " BR | HZ | VA | FU | GR | RA | DZ | PR | SH | BC | VC | MI | SN | SG | IC | PL | _
GR | VU | DU | SA | PO | SQ | FC | SS | DS | FZ | FG | TS |[-]|[+]|shsnra|radz|shra|shgs|shrasn|tsra|rasn|mifg" 'Suchbegriffe durch | trennen
End With
LRow = IIf(IsEmpty(Cells(200, 3)), Cells(200, 3).End(xlUp).Row, 200)
Set Bereich = Range("C6:C" & LRow) 'Suchbereich
For Each Bereich In Bereich
If Bereich "" Then
Set objMatch = objRegEx.Execute(Bereich.Text)
For i = 0 To objMatch.Count - 1
With Bereich.Characters(objMatch(i).FirstIndex + 1, Len(objMatch(i)))
.Font.ColorIndex = 3
.Font.Bold = True
End With
Next i
End If
Next Bereich
Set objMatch = Nothing: Set objRegEx = Nothing
Range("A1").Select
End Sub
Wenn es z.B. in Zelle C16 heißt:
METAR EGNX 151720Z 24003KT 3500 BR OVC004 BR 11/10 Q1032=
Es sollen also die BR markiert werden.
Oben im Makro wird nur die erste markiert?
Dank und Gruss
mehmet