☰

使用VBA从Excel中提取带有空格的数字

tag-icon • tag-icon vba
使用VBA从Excel中提取带有空格的数字

可能需要使用 VBA 从以下文本中提取数字之间有空格的数字。

单位：1.00，代码：'99213'，M1：'25'，注释：'记录不包括可与 2018 年 1 月 12 日执行的服务分开识别的评估和管理服务的文件。因此，不支持 99213 的修饰符 25。'

当前 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

答案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

在此处输入图片描述

唯一棘手的部分是丢弃小数点并清理一些其他特殊字符。

答案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

相关内容