如何用VBA处理250万行超大型CSV文件？含合并拆分需求

针对你这种1GB+的超大CSV文件，直接用Excel加载肯定会崩溃，我们可以通过VBA逐行读取文件流+内存数组+字典分组的方式来处理，全程不依赖Excel加载整个文件，不管是内存占用还是处理效率都会友好很多。下面是具体的实现步骤和代码示例：

一、核心思路拆解 #

1. 逐行读取并清理无效数据：用VBA的Open语句直接读取CSV文件，跳过无效行（比如字段缺失、格式错误的行），只把有效行解析成内存数组。
2. 按id+code分组求和：利用Scripting.Dictionary做分组键，累加对应月份列的值，避免重复遍历浪费资源。
3. 按zip拆分输出Excel：再次用字典按zip分类，批量生成小型Excel文件，全程关闭Excel的屏幕更新、自动计算来提升性能。

二、具体代码实现 #

1. 先引用必要的库 #

打开VBA编辑器后，点击工具→引用，勾选Microsoft Scripting Runtime，这样才能正常使用Dictionary对象。

2. 读取并清理CSV到数组 #

这个函数负责读取CSV，跳过无效行，返回有效数据的二维数组：

Function ReadAndCleanCSV(filePath As String) As Variant
    Dim fileNum As Integer
    Dim lineText As String
    Dim cleanData As Variant
    Dim rowCount As Long
    Dim colCount As Integer
    Dim tempArr As Variant
    
    ' 初始化动态数组（你的CSV有115列）
    rowCount = 0
    ReDim cleanData(1 To 1, 1 To 115)
    
    fileNum = FreeFile()
    Open filePath For Input As #fileNum
    
    ' 跳过表头（如果你的CSV有表头的话，没有就注释掉这行）
    Line Input #fileNum, lineText
    
    Do Until EOF(fileNum)
        Line Input #fileNum, lineText
        tempArr = ParseCSVLine(lineText) ' 处理带引号的CSV字段
        
        ' 判断是否为有效行：这里假设id、code、zip均不为空即为有效
        If UBound(tempArr) = 114 And tempArr(0) <> "" And tempArr(2) <> "" And tempArr(1) <> "" Then
            rowCount = rowCount + 1
            ' 动态扩容数组
            If rowCount > UBound(cleanData, 1) Then
                ReDim Preserve cleanData(1 To rowCount, 1 To 115)
            End If
            ' 把解析后的行存入数组（VBA数组是1开头，CSV解析是0开头）
            For colCount = 1 To 115
                cleanData(rowCount, colCount) = tempArr(colCount - 1)
            Next colCount
        End If
    Loop
    
    Close #fileNum
    
    ' 如果没有有效数据，返回空
    If rowCount = 0 Then
        ReadAndCleanCSV = Empty
    Else
        ReadAndCleanCSV = cleanData
    End If
End Function

' 辅助函数：处理带引号的CSV行拆分（比如字段里包含逗号的情况）
Function ParseCSVLine(line As String) As Variant
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.Pattern = """([^""]*)""|([^,]+)"
    
    Dim matches As Object
    Set matches = regex.Execute(line)
    
    Dim resultArr() As String
    ReDim resultArr(0 To matches.Count - 1)
    
    Dim i As Integer
    For i = 0 To matches.Count - 1
        If matches(i).SubMatches(0) <> "" Then
            resultArr(i) = matches(i).SubMatches(0)
        Else
            resultArr(i) = matches(i).SubMatches(1)
        End If
    Next i
    
    ParseCSVLine = resultArr
End Function

3. 按id+code分组求和月份列 #

这个函数接收清理后的数组，返回分组汇总后的数组：

Function GroupByIDAndCode(rawData As Variant) As Variant
    Dim dict As New Dictionary
    Dim key As String
    Dim i As Long
    Dim j As Integer
    Dim currentRow As Variant
    Dim summaryArr As Variant
    
    ' 遍历每一行有效数据
    For i = 1 To UBound(rawData, 1)
        currentRow = rawData(i, :)
        key = currentRow(1) & "|" & currentRow(3) ' id是第1列，code是第3列，根据你的实际列调整
        
        If Not dict.Exists(key) Then
            ' 首次出现该id+code，初始化汇总数组：zip + 各月份列初始值
            ReDim summaryArr(1 To 115)
            summaryArr(1) = currentRow(1) ' id
            summaryArr(2) = currentRow(2) ' zip
            summaryArr(3) = currentRow(3) ' code
            ' 初始化月份列（假设Jan是第4列，Dec是第15列，根据实际调整）
            For j = 4 To 15
                summaryArr(j) = Val(currentRow(j))
            Next j
            dict.Add key, summaryArr
        Else
            ' 已存在，累加月份列的值
            summaryArr = dict(key)
            For j = 4 To 15
                summaryArr(j) = summaryArr(j) + Val(currentRow(j))
            Next j
            dict(key) = summaryArr
        End If
    Next i
    
    ' 把字典里的汇总数据转成二维数组
    Dim resultArr As Variant
    ReDim resultArr(1 To dict.Count, 1 To 115)
    i = 1
    For Each key In dict.Keys
        resultArr(i, :) = dict(key)
        i = i + 1
    Next key
    
    GroupByIDAndCode = resultArr
End Function

4. 按zip拆分输出到Excel文件 #

这个过程负责把汇总后的数据按zip拆分，生成多个Excel：

Sub SplitByZipToExcel(summaryData As Variant, outputFolder As String)
    Dim dict As New Dictionary
    Dim key As String
    Dim i As Long
    Dim j As Integer
    Dim currentRow As Variant
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' 先按zip分组
    For i = 1 To UBound(summaryData, 1)
        currentRow = summaryData(i, :)
        key = currentRow(2) ' zip是第2列，根据实际调整
        
        If Not dict.Exists(key) Then
            ReDim tempArr(1 To 1, 1 To 115)
            tempArr(1, :) = currentRow
            dict.Add key, tempArr
        Else
            tempArr = dict(key)
            ReDim Preserve tempArr(1 To UBound(tempArr, 1) + 1, 1 To 115)
            tempArr(UBound(tempArr, 1), :) = currentRow
            dict(key) = tempArr
        End If
    Next i
    
    ' 优化Excel性能，避免卡顿
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    ' 遍历每个zip，生成Excel文件
    For Each key In dict.Keys
        Set wb = Workbooks.Add
        Set ws = wb.Sheets(1)
        ws.Name = "Summary-" & key
        
        ' 写入表头（手动定义你的列名，或者从原CSV读取）
        ws.Range("A1").Resize(1, 115).Value = Array("id", "zip", "code", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", ...) ' 补全剩余列名
        
        ' 写入数据
        ws.Range("A2").Resize(UBound(dict(key), 1), 115).Value = dict(key)
        
        ' 保存文件
        wb.SaveAs outputFolder & "\Zip_" & key & ".xlsx"
        wb.Close SaveChanges:=False
    Next key
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    
    Set ws = Nothing
    Set wb = Nothing
    Set dict = Nothing
End Sub

5. 主调用过程 #

把上面的函数串起来执行：

Sub ProcessLargeCSV()
    Dim csvPath As String
    Dim outputFolder As String
    Dim cleanData As Variant
    Dim summaryData As Variant
    
    csvPath = "C:\YourLargeFile.csv" ' 替换成你的CSV文件路径
    outputFolder = "C:\OutputZips" ' 替换成输出文件夹路径，要先手动创建好
    
    ' 第一步：读取并清理数据
    cleanData = ReadAndCleanCSV(csvPath)
    If IsEmpty(cleanData) Then
        MsgBox "没有有效数据！"
        Exit Sub
    End If
    
    ' 第二步：分组求和
    summaryData = GroupByIDAndCode(cleanData)
    
    ' 第三步：拆分输出
    SplitByZipToExcel summaryData, outputFolder
    
    MsgBox "处理完成！"
End Sub

三、关键注意事项 #

• 内存优化：如果250万行有效数据还是导致内存紧张，可以考虑分批次处理（比如每10万行处理一次分组，再合并字典结果），避免内存溢出。
• 字段列号：代码里的列号（比如id是第1列、code是第3列）一定要根据你的实际CSV结构调整，别搞错了。
• CSV格式兼容：ParseCSVLine函数用正则处理带引号的字段，能应对大多数标准CSV格式，但如果你的CSV有特殊格式（比如嵌套引号），可能需要调整正则表达式。
• 错误处理：可以在代码里添加On Error Resume Next或者On Error GoTo的错误处理块，避免中途崩溃丢失进度。

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