Function ЯЩИК(найти As Long, номера As Range) As String
    ЯЩИК = "не найден"
    Dim nrr As Variant
    nrr = номера.Value
    
    Dim arr As Variant
    Dim brr As Variant
    Dim vv As Variant
    Dim ww As Variant
    Dim yn As Long
    Dim iMin As Long
    Dim iMax As Long
    For Each vv In nrr
        If vv <> "" Then
            vv = Trim(vv)
            vv = Replace(vv, ";", ",")
            vv = Replace(vv, ":", "-")
            If InStr(vv, ",") > 0 Then
                arr = Split(vv, ",")
            Else
                ReDim arr(0 To 0)
                arr(0) = vv
            End If
            For Each ww In arr
                ww = Trim(ww)
                If InStr(ww, "-") > 0 Then
                    brr = Split(ww, "-")
                Else
                    ReDim brr(0 To 0)
                    brr(0) = ww
                End If
                iMin = 0
                iMax = 0
                On Error Resume Next
                iMin = CLng(brr(LBound(brr)))
                iMax = CLng(brr(UBound(brr)))
                On Error GoTo 0
                If найти >= iMin Then
                    If найти <= iMax Then
                        ЯЩИК = vv
                        Exit Function
                    End If
                End If
            Next
        End If
    Next
End Function

=ЯЩИК(B1;A1:A100)