Excel VBA数据清洗优化需求：移除硬空格、E+科学计数法并导出Unicode文本

针对你遇到的大型文件卡顿、清洗效果不全的问题，以下是优化后的解决方案，兼顾性能与需求完整性：

核心优化点 #

• 性能提升：减少工作表IO操作，全程基于内存数组处理；关闭更多Excel后台冗余功能，降低资源占用
• 完整清洗逻辑：补充Application.Clean未覆盖的硬空格处理，针对性解决科学计数法"E+"问题，同时保留日期、数值的原始语义
• 批量自动化：自动生成保存路径，避免重复弹窗选择，适合大文件批量处理

优化后代码 #

Sub OptimizedCleanAndSaveAsUnicodeText()
    Dim ws As Worksheet
    Dim data As Variant
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim outputText As String
    Dim filePath As String
    Dim originalFolder As String
    
    ' 最大化性能：关闭所有非必要后台操作
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
        .PrintCommunication = False
    End With
    
    ' 获取原文件所在文件夹路径
    originalFolder = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\"))
    
    For Each ws In ThisWorkbook.Sheets
        ' 获取有效数据范围（优化：基于UsedRange，避免仅依赖A列/第一行的局限性）
        With ws.UsedRange
            lastRow = .Row + .Rows.Count - 1
            lastCol = .Column + .Columns.Count - 1
            data = .Value
        End With
        
        ' 内存中批量处理数据清洗
        For i = 1 To UBound(data, 1)
            For j = 1 To UBound(data, 2)
                Select Case VarType(data(i, j))
                    Case vbDate
                        ' 日期类型：转标准文本格式，避免导出乱码
                        data(i, j) = Format(data(i, j), "yyyy-mm-dd hh:mm:ss")
                    Case vbDouble, vbInteger, vbLong
                        ' 数值类型：强制规避科学计数法
                        If Abs(data(i, j)) >= 10 ^ 15 Or Abs(data(i, j)) <= 10 ^ -15 Then
                            data(i, j) = CStr(CDec(data(i, j)))
                        Else
                            data(i, j) = CStr(data(i, j))
                        End If
                    Case vbString
                        ' 文本类型：Clean函数+移除硬空格+清除E+标识
                        data(i, j) = Application.Clean(data(i, j))
                        data(i, j) = Replace(data(i, j), Chr(160), " ") ' 移除硬空格（非普通空格）
                        data(i, j) = Replace(data(i, j), "E+", "", vbTextCompare) ' 移除科学计数标识
                    Case Else
                        ' 其他类型直接转字符串保留
                        data(i, j) = CStr(data(i, j))
                End Select
            Next j
        Next i
        
        ' 生成制表符分隔的Unicode文本内容
        outputText = ""
        For i = 1 To UBound(data, 1)
            For j = 1 To UBound(data, 2)
                outputText = outputText & data(i, j) & vbTab
            Next j
            ' 替换每行末尾制表符为换行符
            outputText = Left(outputText, Len(outputText) - 1) & vbCrLf
        Next i
        
        ' 自动生成保存路径（原文件夹+工作表名_Cleaned.txt）
        filePath = originalFolder & ws.Name & "_Cleaned.txt"
        
        ' 直接写入Unicode文本文件，比SaveAs更高效
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Dim ts As Object
        Set ts = fso.CreateTextFile(filePath, True, True) ' 第三个参数=True表示Unicode编码
        ts.Write outputText
        ts.Close
        Set ts = Nothing
        Set fso = Nothing
        
        Debug.Print "已完成导出：" & filePath
    Next ws
    
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
        .PrintCommunication = True
    End With
    
    MsgBox "所有工作表已完成清洗并导出为Unicode文本！", vbInformation
End Sub

关键改动说明 #

1. 性能优化细节：

   • 关闭EnableEvents、DisplayAlerts等后台功能，避免Excel触发不必要的事件或弹窗
   • 使用UsedRange获取有效数据范围，比原代码依赖A列/第一行更准确
   • 直接用FileSystemObject写入文本，跳过Excel的SaveAs格式转换流程，大幅提升大文件处理速度

2. 清洗逻辑补全：

   • 硬空格（Chr(160)）是网页复制或系统生成的常见非打印空格，Application.Clean无法处理，需手动替换为普通空格
   • 针对超大/极小数值，用CDec转换为十进制格式，避免转字符串时出现科学计数法；常规数值直接转字符串保留原始格式
   • 文本中的"E+"标识通过Replace直接移除，确保清洗彻底

3. 自动化处理：

   • 自动读取原文件所在文件夹，生成带"_Cleaned"后缀的文件名，无需手动选择路径
   • 调试窗口输出导出路径，方便追踪批量处理进度

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