Как извлечь все шестизначные числа из точной ячейки?

Question

Например, наша ячейка содержит:

EWFS 410461, 501498, EFW406160

Итак, мне нужна формула, которая возвращается с

410461 501498 406160

Answer 1

Рассмотрим следующую пользовательскую функцию:

Public Function GetNumbers(s As String) As String
    Dim L As Long, i As Long, wf As WorksheetFunction
    Set wf = Application.WorksheetFunction

    L = Len(s)
    For i = 1 To L
        If Mid(s, i, 1) Like "[A-Z]" Or Mid(s, i, 1) = "," Then Mid(s, i, 1) = " "
    Next i

    GetNumbers = wf.Trim(s)

End Function

Все числа будут возвращены как строка, разделенная пробелами

Answer 2

Если у вас Office 365, вы можете использовать эту формулу массива:

=TEXTJOIN(" ",TRUE,IF((ISNUMBER(--MID(A1,ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),6)))*(NOT(ISNUMBER(--MID(A1&";",ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),7)))),MID(A1,ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),6),""))

Будучи формулой массива, она должна быть подтверждена Ctrl-Shift-Enter вместо Enter при выходе из режима редактирования.

Answer 3

небольшое изменение ответа ученика Гэри:

Public Function GetNumbers2(s As String) As String
    Dim i As Long, elem As Variant

    For Each elem In Split(s, ",")
        For i = 1 To Len(elem)
            If Mid(elem, i, 1) Like "[0-9]" Then Exit For
        Next i
        GetNumbers2 = GetNumbers2 & " " & Application.WorksheetFunction.Trim(Mid(elem, i))
    Next
    GetNumbers2 = Trim(GetNumbers)
End Function

Answer 4

Если «E», «W», «F» и «S» - единственные буквы, от которых вы должны избавиться, вы можете избежать VBA и использовать функцию SUBSTITUTE ():

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(B2,"E",""),"W",""),"F",""),"S",""),",",""))

Answer 5

Этот ответ не лучше , чем другие с положительными оценками, но я предпочитаю использовать ASCII-коды для обработки символов в строке.Это позволяет диапазонам, которые организованы чисто с Select Statements.Это особенно полезно для отклонения символов от неискушенных пользователей, таких как мои родители (я не назвал их внука "4").

Ниже приведен UDF, который будет работать для OP, но также показывает, как можно использовать функция VBA Asc в сочетании с оператором выбора для обработки, прописными / строчными буквами или любыми другими конкретными символами:

Public Function GiveTheNumbers(theINPUT As String) As String
Dim p As Long, aCode As Long

For p = 1 To Len(theINPUT)

    aCode = Asc(Mid(theINPUT, p, 1)) 'converts string to an ascii integer

    Select Case aCode

        '32 is the ascii code for space bar. 48 to 57 is zero to nine.
        Case 32, 48 To 57
            GiveTheNumbers = GiveTheNumbers & Chr(aCode) 'Chr() converts integer back to string


        'the rest of these cases are not needed for the OP but I'm including for illustration
        Case 65 To 90
            'all upper case letters

        Case 97 To 122
            'all lower case letters

        Case 33, 64, 35, 36, 37, 42
            'my favorite characters of: !@#$%*

        Case Else
            'anything else

    End Select

Next p

End Function

Answer 6

NDIGITS (UDF)

Формула Excel

=NDIGITS($A1,6)

Пример данных

Код VBA

'******************************************************************************
' Purpose:    From a string, returns digit groups (numbers) in a delimited
'             string.
' Inputs
'   SourceString    - Required. The string to be checked for digits.
'   NumberofDigits  - Optional. The number of digits in digit groups. If 0,
'                     all digit groups are returned. Default: 0.
'   TargetDelimiter - Optional. The delimiter of the returned string.
'                     Default: " " (space).
'******************************************************************************
Function NDigits(ByVal SourceString As String, _
        Optional ByVal NumberOfDigits As Long = 0, _
        Optional ByVal TargetDelimiter As String = " ") As String

    Dim i As Long         ' SourceString Character Counter
    Dim strDel As String  ' Current Target String

    ' Check if SourceString is empty (""). Exit if. NDigits = "".
    If SourceString = "" Then Exit Function

    ' Loop through characters of SourceString.
    For i = 1 To Len(SourceString)
        ' Check if current character is not a digit (#), then replace with " ".
        If Not Mid(SourceString, i, 1) Like "#" Then _
                Mid(SourceString, i, 1) = " "
    Next

    ' Note: While VBA's Trim function removes spaces before and after a string,
    '       Excel's Trim function additionally removes redundant spaces, i.e.
    '       doesn't 'allow' more than one space, between words.
    ' Remove all spaces from SourceString except single spaces between words.
    strDel = Application.WorksheetFunction.Trim(SourceString)

    ' Check if current TargetString is empty (""). Exit if. NDigits = "".
    If strDel = "" Then Exit Function

    ' Replace (Substitute) " " with TargetDelimiter if it is different than
    ' " " and is not a number (#).
    If TargetDelimiter <> " " And Not TargetDelimiter Like "#" Then
        strDel = WorksheetFunction.Substitute(strDel, " ", TargetDelimiter)
    End If

    ' Check if NumberOfDigits is greater than 0.
    If NumberOfDigits > 0 Then

        Dim vnt As Variant  ' Number of Digits Array (NOD Array)
        Dim k As Long       ' NOD Array Element Counter

        ' Write (Split) Digit Groups from Current Target String to NOD Array.
        vnt = Split(strDel, TargetDelimiter)
        ' Reset NOD Array Element Counter to -1, because NOD Array is 0-based.
        k = -1
        ' Loop through elements (digit groups) of NOD Array.
        For i = 0 To UBound(vnt)
            ' Check if current element has number of characters (digits)
            ' equal to NumberOfDigits.
            If Len(vnt(i)) = NumberOfDigits Then
               ' Count NOD Array Element i.e. prepare for write.
               k = k + 1
               ' Write i-th element of NOD Array to k-th element.
               ' Note: Data (Digit Groups) are possibly being overwritten.
               vnt(k) = vnt(i)
            End If
        Next
        ' Check if no Digit Group of size of NumberOfDigits was found.
        ' Exit if. NDigits = "".
        If k = -1 Then Exit Function
        ' Resize NOD Array to NOD Array Element Count, possibly smaller,
        ' due to fewer found Digit Groups with the size of NumberOfDigits.
        ReDim Preserve vnt(k)
        ' Join elements of NOD Array to Current Target String.
        strDel = Join(vnt, TargetDelimiter)
    End If

    ' Write Current Target String to NDigits.
    NDigits = strDel

End Function
'******************************************************************************
' Remarks:    A digit group are consecutive numbers in the string e.g.
'             in the string "123 sdf jk 23 4" there are three digit groups:
'             The 1st is 123 with NumberOfDigits = 3, the 2nd is 23 with
'             NumberOfDigits = 2 and finally 4 with NumberOfDigits = 1. Since
'             they all have a different number of digits, all will be returned
'             if NumberOfDigits is 0 or omitted, otherwise only one will be
'             returned.
'******************************************************************************

Answer 7

используйте функцию Right() и получите 6 самых правых символов. например:

 Right(cell.Value, 6)

, где cell - это некоторая Range переменная, обращающаяся к соответствующей ячейке

например

Dim cell As Range
For Each cell In Range("B2:D2") ' change "B2:D2" to your actual range woth values
    Debug.Print Right(cell.Value, 6)
Next