Extraindo números com espaços do Excel usando o VBA

Question

É necessário extrair números do texto a seguir com espaços entre números usando o VBA, possivelmente.

Units : 1.00, Code: '99213', M1: '25',Comments: 'Records do not include documentation of an evaluation and management service that is separately identifiable from the service also performed on 01/12/2018. Therefore the modifier 25 for 99213 is not supported.'

O VBA atual extrai os números, mas coloca neste formato:

10099213125011220182599213 que inclui datas - não é necessário.

Gostaria de ver:

100 99213 25 .

Aqui está o meu código atual:

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

Isso parece funcionar:

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

A única parte complicada era descartar o ponto decimal e limpar alguns outros caracteres especiais.

    

Answer 2

Outra opção

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