VBA中快速移除超大型字符串冗余空格的方法

处理4500万+字符的超大字符串，慢得让人抓狂对吧？Replace循环逐次替换这种笨办法在这么大的体量下肯定行不通——毕竟每次替换都要重新扫描整个字符串，效率低得离谱。给你几个实测下来快得多的解决方案，按需选就行：

方案1：VBScript正则表达式（简洁高效） #

正则引擎是经过高度优化的，一次性扫描就能完成所有连续空格的替换，比手动循环Replace快好几个量级。代码也很简洁：

Function RemoveExtraSpacesRegex(ByVal inputStr As String) As String
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = True
        .Pattern = " +"  ' 仅匹配ASCII 32连续空格，若要匹配所有空白字符（制表符/换行等）改成 "\s+"
    End With
    RemoveExtraSpacesRegex = regEx.Replace(inputStr, " ")
    ' 可选：移除首尾空格，不需要的话可以删掉这行
    RemoveExtraSpacesRegex = Trim(RemoveExtraSpacesRegex)
End Function

方案2：字节数组直接操作（性能进阶） #

VBScript的字符串本质是Unicode字节数组（每个字符占2字节），直接操作字节可以避免字符串操作带来的内存拷贝开销，对于超大型字符串来说，这个方法的性能比正则还要出色：

Function RemoveExtraSpacesByte(ByVal inputStr As String) As String
    Dim byteArr() As Byte
    Dim outputArr() As Byte
    Dim i As Long, j As Long
    Dim lastWasSpace As Boolean
    
    If inputStr = "" Then
        RemoveExtraSpacesByte = ""
        Exit Function
    End If
    
    byteArr = inputStr
    ' 预分配足够空间，后续再截断
    ReDim outputArr(0 To UBound(byteArr))
    
    lastWasSpace = False
    j = 0
    
    ' 按Unicode字符遍历（步长2，因为每个字符占2字节）
    For i = 0 To UBound(byteArr) Step 2
        ' 判断当前是否是ASCII 32空格（Unicode中对应字节为&H2000）
        If byteArr(i) = 32 And byteArr(i + 1) = 0 Then
            If Not lastWasSpace Then
                outputArr(j) = 32
                outputArr(j + 1) = 0
                j = j + 2
                lastWasSpace = True
            End If
        Else
            outputArr(j) = byteArr(i)
            outputArr(j + 1) = byteArr(i + 1)
            j = j + 2
            lastWasSpace = False
        End If
    Next i
    
    ' 截断数组到实际有效长度
    If j > 0 Then
        ReDim Preserve outputArr(0 To j - 1)
        RemoveExtraSpacesByte = outputArr
    Else
        RemoveExtraSpacesByte = ""
    End If
    
    ' 可选：移除首尾空格
    RemoveExtraSpacesByte = Trim(RemoveExtraSpacesByte)
End Function

方案3：Windows API内存操作（极致性能） #

如果追求绝对的速度上限，直接调用Windows内存操作API是最优解——跳过VBA的字符串处理层，直接在内存层面复制有效字符，性能拉满。注意要兼容32/64位Office：

' 32/64位兼容声明
#If VBA7 Then
    Declare PtrSafe Function RtlMoveMemory Lib "kernel32" (ByVal dest As LongPtr, ByVal src As LongPtr, ByVal length As Long) As Long
#Else
    Declare Sub RtlMoveMemory Lib "kernel32" (ByVal dest As Long, ByVal src As Long, ByVal length As Long)
#End If

Function RemoveExtraSpacesAPI(ByVal inputStr As String) As String
    Dim inputLen As Long, outputLen As Long
    Dim inputPtr As LongPtr, outputPtr As LongPtr
    Dim outputStr As String
    Dim i As Long, j As Long
    Dim lastWasSpace As Boolean
    
    inputLen = Len(inputStr)
    If inputLen = 0 Then
        RemoveExtraSpacesAPI = ""
        Exit Function
    End If
    
    ' 预分配输出字符串空间
    outputStr = Space$(inputLen)
    inputPtr = StrPtr(inputStr)
    outputPtr = StrPtr(outputStr)
    
    lastWasSpace = False
    j = 0
    
    For i = 0 To inputLen - 1
        ' 判断当前字符是否是ASCII 32空格
        If AscW(Mid$(inputStr, i + 1, 1)) = 32 Then
            If Not lastWasSpace Then
                ' 复制当前空格字符到输出内存
                RtlMoveMemory outputPtr + j * 2, inputPtr + i * 2, 2
                j = j + 1
                lastWasSpace = True
            End If
        Else
            ' 复制非空格字符到输出内存
            RtlMoveMemory outputPtr + j * 2, inputPtr + i * 2, 2
            j = j + 1
            lastWasSpace = False
        End If
    Next i
    
    ' 截断输出字符串到有效长度
    If j > 0 Then
        RemoveExtraSpacesAPI = Left$(outputStr, j)
    Else
        RemoveExtraSpacesAPI = ""
    End If
    
    ' 可选：移除首尾空格
    RemoveExtraSpacesAPI = Trim(RemoveExtraSpacesAPI)
End Function

额外注意事项 #

• 如果不需要处理首尾空格，记得删掉每个函数最后的Trim步骤，能节省一点处理时间
• 正则方案里，Pattern = " +"只会处理ASCII 32空格，如果需要处理制表符、换行等所有空白字符，改成Pattern = "\s+"
• 测试时建议先用小字符串验证逻辑，再应用到超大字符串上，避免意外问题

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