Как из ячейки содержащей текст и число извлечь только число?

[АННА-ЕАО]

Здравствуйте, помогите пожалуйста.

В одной ячейке по графе А содержится текс и число. Как в соседнюю ячейку графы В извлечь только число.

Не через раз «Текс по столбцам», а формулой или макросом. Так как таких ячеек много и текст везде разный и критерии для разбивки разные.

Т.е. на данный момент я делаю это процедуру через «Текс по столбцам», но после чего необходимо ещё «дорабатывать» много.

Возможно, есть более удобное и быстрое решение, кто знает, подскажите пожалуйста.

Вложен пример в оригинале ячеек с подобным текстом больше и разнообразней.

[Hugo121]

Выделить данные в А, затем

Sub tt()
Dim cc As Range
For Each cc In Selection
cc.Offset(, 1) = Split(cc)(UBound(Split(cc)))
Next
End Sub

Ну или вместо Selection явно указать диапазон.
Но правда так есть косяк в МОУ СОШ N56
Если нужны цифры не как текст, то добавьте --:
cc.Offset(, 1) = --Split(cc)(UBound(Split(cc)))
Но опять же на N56 будет уже ошибка.

Хотя сразу не заметил (в низ промотал) - там есть ещё 3 строки с нецифрами в конце...
Тогда используйте UDF или её алгоритм:

'---------------------------------------------------------------------------------------
' Module    : mNumberFromText
' DateTime  : 18.03.2011 15:21
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             www.excel-vba.ru
' Purpose   : http://www.planetaexcel.ru/forum.php?thread_id=25683
'---------------------------------------------------------------------------------------


Function Extract_Number_from_Text(sWord As String, Optional Metod As Integer)    '0 числа, 1 текст
    Dim sSymbol As String, sInsertWord As String
    Dim i As Integer

    If sWord = "" Then Extract_Number_from_Text = "Нет данных!": Exit Function
    sInsertWord = ""
    sSymbol = ""
    For i = 1 To Len(sWord)
        sSymbol = Mid(sWord, i, 1)
        If Metod = 1 Then
            If Not LCase(sSymbol) Like "*[0-9]*" Then
                If sSymbol = "," Or sSymbol = "." Or sSymbol = " " Then
                    If Mid(sWord, i - 1, 1) Like "*[0-9]*" And Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        Else
            If LCase(sSymbol) Like "*[0-9.,;:-]*" Then
                If LCase(sSymbol) Like "*[.,]*" Then
                    If Not Mid(sWord, i - 1, 1) Like "*[0-9]*" Or Not Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        End If
    Next i
    Extract_Number_from_Text = sInsertWord

End Function

Ещё

Function GetNumeric(t As Range)
    Dim j As Integer, l As String
    For j = 1 To Len(t)
        If IsNumeric(Mid(t, j, 1)) Then l = l & Mid(t, j, 1)
    Next j
    GetNumeric = Val(l)
End Function

Public Function ExtractNumber(S As String)
    Dim i As Integer, str As String
    For i = 1 To Len(S)
        If InStr(1, "1234567890,", Mid(S, i, 1)) <> 0 Then str = str & Mid(S, i, 1)
    Next
    ExtractNumber = str
End Function

Function NumbersOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[^0-9,]"    '"\D"
        NumbersOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function

Function Num(Текст As String) As Long
    For n = 1 To Len(Текст)
        If Mid(Текст, n, 1) Like "#" Then Num = Num & Mid(Текст, n, 1)
    Next n
End Function

[MCH]

Формулой:

=ПРОСМОТР(9999;--ПСТР(A1;ПОИСК("N";A1)+1;{1;2;3;4}))

[vefer]

В вашем случае можно так:

=ПРАВСИМВ(A1;ДЛСТР(A1)-НАЙТИ("N ";A1))

[Hugo121]

В общем, нужно смотреть на данные - все способы могут накосячить.
Вдруг N будет в названии?
Или будет №36?
Или в названии будет цифра? Например "МОУ прогимназия № 66 "Революции 1905 года"

[vefer]

Ну не просят-же написать универсальную форму, если формат всех надписей одинаков в данном случае.

[Hugo121]

А вот

=RIGHT(A5;LEN(A5)-FIND("N ";A5))

тут как раз накосячит (как и мой первый макрос) на данных типа

МОУ прогимназия N 132 "Альтаир"

[MCH]

Сообщение от Hugo121

А вот

=RIGHT(A5;LEN(A5)-FIND("N ";A5))

тут как раз накосячит (как и мой первый макрос) на данных типа

МОУ прогимназия N 132 "Альтаир"

А моя формула справляется

[Hugo121]

Справляется. На трёх цифрах, если перед ними один пробел. А если больше?

[MCH]

Сообщение от Hugo121

Справляется. На трёх цифрах, если перед ними один пробел. А если больше?

В примере этого нет, специально ограничил тремя цифрами, т.к. нет двойных пробелов и максимальное число - трехзначное, если будет больше знаков, то формула легко переделывается