AW: Teil suchen und komplettes Wort markieren
16.12.2019 14:35:52
Nepumuk
Hallo,
teste mal:
Option Explicit
Public Sub Markieren()
Dim strFirstAddress As String, strInput As String
Dim lngRow As Long, lngStart As Long
Do
strInput = InputBox("Bitte die ersten zwei Ziffern des Kontos eingeben.", "Eingabe")
If StrPtr(strInput) = 0 Then Exit Sub
If strInput Like "##" Then Exit Do
Call MsgBox("Bitte eine zweistellige Zahl eingeben.", vbExclamation, "Hinweis")
Loop
With Worksheets("Tabelle1") ' Tabellennamen anpassen !!!
For lngRow = 3 To .Cells(.Rows.Count, 4).End(xlUp).Row
lngStart = SearchNumber(strInput, .Cells(lngRow, 4).Text)
If lngStart > 0 Then .Cells(lngRow, 4).Characters(lngStart + 1, 6).Font.Color = vbRed
Next
End With
End Sub
Private Function SearchNumber(ByVal strDigits As String, pvstrText As String) As Long
Dim objRegEx As Object, objMatch As Object
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strDigits & "\d{4}"
Set objMatch = .Execute(pvstrText)
End With
If objMatch.Count = 1 Then SearchNumber = objMatch(0).FirstIndex
End Function
Gruß
Nepumuk