Option Explicit

Sub Поиск_и_выделение()
    FindJob "Select"
End Sub

Sub Поиск_и_заливка()
    FindJob "Color"
End Sub

Private Sub FindJob(sMode As String)

    Dim sFind As String
    sFind = InputBox("Введите искомую строку", "Поиск", "02.2025")
    If sFind = "" Then Exit Sub
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    Dim rr As Range
    Set rr = GetRangeByString(Selection, sFind)
    If rr Is Nothing Then Exit Sub
    
    Select Case sMode
    Case "Select": rr.Select
    Case "Color": rr.Interior.Color = RGB(200, 255, 200)
    End Select
End Sub

Private Function GetRangeByString(rr As Range, sFind As String) As Range
    Dim ru As Range
    On Error Resume Next
    Set ru = Intersect(rr, rr.Parent.UsedRange)
    On Error GoTo 0
    If ru Is Nothing Then Exit Function
    
    Dim res As Range
    Dim cl As Range
    For Each cl In rr.Cells
        If InStr(cl.Value, sFind) > 0 Then
            myUnion res, cl
        End If
    Next
    Set GetRangeByString = res
End Function

Private Sub myUnion(ru As Range, cl As Range)
    If ru Is Nothing Then
        Set ru = cl
    Else
        Set ru = Union(ru, cl)
    End If
End Sub