VBA传入字符串转单字符数组并提取数值字符异常求助

问题分析 #

你的代码存在三个核心问题，导致数组为空或返回大量空值：

• 循环语法错误：原循环For i = Len(strArg) To i = 1是无效写法，VBA反向遍历必须使用DownTo关键字，否则循环体根本不会执行，数组自然为空。
• 动态数组未初始化：仅声明Dim arr() As Variant后，未用ReDim分配数组空间，直接赋值会导致数组未被正确初始化。
• 逻辑不符合需求：原代码将非数值字符设为空字符串存入数组，最后Join会保留这些空值，而你需要的是移除非数值字符，而非保留空占位。

修改建议 #

以下提供两种符合需求的实现方式：

方式一：直接拼接数值字符（高效简洁）

无需数组操作，直接遍历字符串收集数值字符：

Function ExtractNumbers(strArg As String) As String
    Dim newStr As String
    Dim i As Integer
    newStr = ""
    
    ' 正向遍历字符串，只保留数值字符
    For i = 1 To Len(strArg)
        If IsNumeric(Mid$(strArg, i, 1)) Then
            newStr = newStr & Mid$(strArg, i, 1)
        End If
    Next i
    
    ExtractNumbers = newStr
End Function

方式二：数组实现（修正原代码逻辑）

若坚持使用数组，需先统计数值字符数量，再初始化数组填充有效内容：

Function ExtractNumbersWithArray(strArg As String) As String
    Dim arr() As String
    Dim i As Integer
    Dim numCount As Integer
    numCount = 0
    
    ' 第一步：统计数值字符的总数量
    For i = 1 To Len(strArg)
        If IsNumeric(Mid$(strArg, i, 1)) Then
            numCount = numCount + 1
        End If
    Next i
    
    ' 初始化数组大小（仅分配有效元素的空间）
    ReDim arr(1 To numCount)
    numCount = 0 ' 重置计数器用于填充数组
    
    ' 第二步：遍历字符串填充数组
    For i = 1 To Len(strArg)
        If IsNumeric(Mid$(strArg, i, 1)) Then
            numCount = numCount + 1
            arr(numCount) = Mid$(strArg, i, 1)
        End If
    Next i
    
    ' 拼接数组为最终字符串
    ExtractNumbersWithArray = Join(arr, "")
End Function

关键修改点说明 #

1. 修正循环遍历语法，确保循环正常执行；
2. 移除非数值字符的空占位逻辑，直接过滤无效字符；
3. 数组实现时先统计有效元素数量，避免分配多余空间，彻底解决空值问题。

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