Извлечение чисел с пробелами из Excel с использованием VBA

Question

Необходимо извлечь числа из следующего текста с пробелами между числами, используя VBA, возможно.

Единицы: 1,00, код: «99213», M1: «25», комментарии: «Записи не включают в себя документацию службы оценки и управления, которую можно отдельно идентифицировать из службы, также выполненной 12.01.2008. Поэтому модификатор 25 для 99213 не поддерживается.'

Текущий VBA извлекает числа, но помещает в этот формат:

10099213125011220182599213 который включает даты - не нужно.

Хотел бы видеть:

100 99213 25 .

Вот мой текущий код:

Function OnlyNums(strWord As String) As String
    Dim strChar As String
    Dim x As Integer
    Dim strTemp As String
    strTemp = ""
    Application.ScreenUpdating = False
    For x = 1 To Len(strWord)
        strChar = Mid(strWord, x, 1)
        If Asc(strChar) >= 48 And _
          Asc(strChar) <= 57 Then
            strTemp = strTemp & strChar
        End If
    Next
    Application.ScreenUpdating = True
    OnlyNums = "'" & strTemp & "'"
End Function

Answer 1

Это похоже на работу:

Function OnlyNums(strWord As String) As String
    Dim s As String
    s = Replace(strWord, ",", " ")
    s = Replace(s, ".", "")
    s = Replace(s, "'", " ")
    s = Application.WorksheetFunction.Trim(s)
    ary = Split(s, " ")
    OnlyNums = ""
    For Each a In ary
        If IsNumeric(a) Then OnlyNums = OnlyNums & " " & a
    Next a
End Function

Единственная сложная часть заключалась в отбрасывании десятичной точки и очистке некоторых других специальных символов.

Answer 2

Другой вариант

Option Explicit

Public Function OnlyNums(ByVal txt As String) As String

    Dim arr As Variant, itm As Variant, unit As Variant
    Dim i As Long, ltr As String, ascLtr As Long, nums As String

    txt = Left(txt, InStr(1, txt, ",Comments:")) 'extract just the part before "Comments"

    arr = Split(txt, ",")

    For Each itm In arr
        itm = Trim$(itm)
        If InStr(1, itm, ":") > 0 Then unit = Split(itm, ":")(1) Else unit = itm
        For i = 1 To Len(unit)
            ltr = Mid(unit, i, 1)
            ascLtr = Asc(ltr)
            If ascLtr >= 48 And ascLtr <= 57 Then nums = nums & ltr
        Next
        nums = nums & " "
    Next
    OnlyNums = "'" & Trim$(nums) & "'"
End Function