导入70万行文本文件时Excel崩溃，求VBA优化及防崩溃方案

问题背景 #

处理70万+行的文本文件时，使用现有VBA宏导入Excel会频繁崩溃，需优化代码以高效处理大数据集并避免程序崩溃。

核心优化建议 #

• 禁用更多Excel后台功能：除屏幕更新、手动计算外，额外禁用事件触发、显示警告，减少不必要的资源占用
• 简化数组处理逻辑：移除中间过渡数组，直接构建目标数据数组，降低内存开销
• 减少工作表交互次数：适当调大分块读取的尺寸，减少向工作表写入数据的次数
• 添加错误处理与资源清理：捕获文件IO异常，确保程序出错时能恢复Excel设置、释放占用资源
• 使用Value2替代Value：跳过格式转换步骤，提升数据写入速度

优化后的VBA代码 #

Option Explicit
Sub ImportLargeTextFiles()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim ws As Worksheet
    Dim dataArray() As Variant
    Dim i As Long, j As Long
    Dim startTime As Double
    Dim lineCount As Long
    Dim chunkSize As Long
    Dim filePath As String
    Dim fileStream As Object
    Dim lineText As String

    ' 禁用Excel后台功能，降低资源消耗
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.StatusBar = "正在导入数据..."

    ' 启动计时
    startTime = Timer

    ' 创建FileSystemObject实例
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 选择文本文件所在文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含文本文件的文件夹"
        If .Show <> -1 Then
            GoTo Cleanup
        End If
        Set folder = fso.GetFolder(.SelectedItems(1))
    End With

    ' 创建或复用输出工作表
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("Imported Data")
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.Name = "Imported Data"
    End If
    ws.Cells.Clear

    ' 设置表头
    ws.Cells(1, 1).Value = "文件名"
    ws.Cells(1, 2).Value = "行内容"

    ' 初始化变量
    i = 2  ' 从第2行开始（跳过表头）
    chunkSize = 50000  ' 调大分块尺寸，可根据内存情况调整

    ' 遍历文件夹内的文本文件
    For Each file In folder.Files
        If LCase(Right(file.Name, 4)) = ".txt" Then
            filePath = file.Path
            Set fileStream = fso.OpenTextStream(filePath, 1) ' 1 = 只读模式

            ' 分块读取并写入数据
            Do While Not fileStream.AtEndOfStream
                lineCount = 0
                ' 预分配分块数组空间
                ReDim dataArray(1 To chunkSize, 1 To 2)

                ' 读取当前分块的内容
                Do While lineCount < chunkSize And Not fileStream.AtEndOfStream
                    lineCount = lineCount + 1
                    lineText = fileStream.ReadLine
                    dataArray(lineCount, 1) = file.Name
                    dataArray(lineCount, 2) = lineText
                Loop

                ' 将分块数据写入工作表，用Value2提升速度
                If lineCount > 0 Then
                    ws.Cells(i, 1).Resize(lineCount, 2).Value2 = dataArray
                    i = i + lineCount
                    ' 更新状态栏显示进度
                    Application.StatusBar = "已导入 " & (i - 2) & " 行..."
                End If
            Loop

            fileStream.Close
        End If
    Next file

    ' 格式化工作表
    With ws
        .Columns("A:B").AutoFit
        .Rows(1).Font.Bold = True
    End With

    ' 导入完成提示
    MsgBox "导入完成，耗时 " & Format(Timer - startTime, "0.00") & " 秒", vbInformation

Cleanup:
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    ' 释放占用的对象资源
    Set fileStream = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing
    Set ws = Nothing
End Sub

额外注意事项 #

• 内存适配：若单文件行数超过100万，可适当调小chunkSize，避免内存溢出
• 编码兼容：如果文本文件是UTF-8等非ANSI编码，需在OpenTextStream中指定编码参数（如fso.OpenTextStream(filePath, 1, False, 65001)对应UTF-8）
• 格式简化：导入前确保目标工作表无合并单元格、复杂条件格式等，减少写入时的资源消耗

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