如何修改VBA函数以提取字符串中的所有十进制数？

原代码仅能返回单个匹配的十进制数，要提取所有符合条件的数值，我们可以修改函数以支持返回数组（或分隔符拼接的字符串），以下是具体修改方案：

修改后的代码 #

Function realNum(str As String, _
                  Optional ndx As Integer = 0) As Variant
    Dim tmpArr() As Double
    Dim matches As Object
    Dim i As Integer
    Static rgx As Object

    ' 静态正则对象只需初始化一次，提升批量调用效率
    If rgx Is Nothing Then
        Set rgx = CreateObject("VBScript.RegExp")
    End If

    With rgx
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
        .Pattern = "\d{1,9}\.\d{1,9}" ' \d等价于[0-9]，简化匹配写法
        If .Test(str) Then
            Set matches = .Execute(str)
            ' 指定索引时返回单个值，兼容原用法
            If ndx > 0 Then
                realNum = IIf(ndx <= matches.Count, CDbl(matches(ndx - 1)), 0)
            Else
                ' 未指定索引时返回所有匹配值的数组
                ReDim tmpArr(1 To matches.Count)
                For i = 1 To matches.Count
                    tmpArr(i) = CDbl(matches(i - 1))
                Next i
                realNum = tmpArr
            End If
        Else
            ' 无匹配项时返回空值，可按需改为0或空字符串
            realNum = Empty
        End If
    End With
End Function

关键修改说明 #

• 返回类型适配：将函数返回类型显式设为Variant，既支持返回单个数值，也能返回存储所有结果的数组。
• 遍历所有匹配项：通过正则Execute方法返回的Matches集合，循环提取所有符合规则的十进制数，存入数组后返回。
• 兼容原有逻辑：保留可选参数ndx，传入正整数时返回对应位置的数值；不传入或传入0时返回全部匹配结果。
• 正则简化：用\d替代[0-9]，语法更简洁且功能一致。

使用方式 #

1. 提取单个值：和原用法一致，比如=realNum("60.75X30.75 Oak",2)会返回30.75。
2. 提取所有值：在Excel中选中与匹配数量对应的单元格（比如2个单元格），输入=realNum("60.75X30.75 Oak")后按下Ctrl+Shift+Enter（数组公式输入方式），即可在选中单元格中分别得到60.75和30.75。若需要用逗号分隔的字符串形式返回，可将数组拼接逻辑替换为：

realNum = Join(tmpArr, ", ")

内容的提问来源于stack exchange，提问作者Smak