使用VBA读取多份CSV文件并压缩百万行数据至百行级（含更新）

背景与需求 #

有一批自动生成的CSV文件，命名格式为R_Data_YYYY_MM_DD，每份含7列、10万+行数据，示例结构如下：

RowID;Date     ;Type  ;Lot     ;Part  ;Test1;Test2
10256;22-2-2022;type 4;24051000;100001;OK   ;NOK
10257;22-2-2022;type 4;24051000;100001;NOK  ;-  

需求明确：

• 忽略RowID和Type列
• 按Date、Lot、Part的唯一组合聚合，统计该组合下Test1=NOK、Test2=NOK的数量，以及对应组合的总行数
• 重复运行处理代码时，需更新现有统计数据而非追加重复项
• 此前用Excel处理因行限制无法长期维护，现有Access VBA代码如下：

Option Compare Database
Option Explicit

Public Function Import_files()

Dim report_path As String, file_name As String
Dim db As DAO.Database
Dim strSQL As String

Set db = CurrentDb
' ..// specify where to find the files to import \..
report_path = "C:\documents\"
file_name = Dir(report_path & "*.csv", vbDirectory)

Do While file_name <> vbNullString
    DoCmd.TransferText acImportDelim, "SemiColonDelim", (Replace(file_name, ".csv", "")), report_path & file_name, True
'..//sql statement to collect and transform data per imported table\..
    strSQL = "INSERT INTO [Tested] ([Date], [Lot], [Part], [Test1], [Test2], [Approved], [Total]) " & _
             "SELECT [Date], [Lot], [Part], " & _
             "SUM(IIF (Leak = " & Chr(34) & "Fout" & Chr(34) & ",1,0)) as Test1, " & _
             "SUM(IIF (Camera = " & Chr(34) & "Fout" & Chr(34) & ",1,0)) AS Test2, " & _
             "SUM(IIF (Camera = " & Chr(34) & "Goed" & Chr(34) & ",1,0)) AS Approved, " & _
             "COUNT(*) AS [Total] " & _
             "FROM [" & (Replace(file_name, ".csv", "")) & "] " & _
             "GROUP BY [Date], [Lot], [Part]"
    db.Execute strSQL
'..//setting up next file to import\..
        file_name = Dir
    Loop
    
    MsgBox "Data files imported", vbInformation
    
    End Function

改进思路 #

1. 解决重复数据问题（实现更新而非追加） #

现有代码直接INSERT会导致重复统计，可通过以下两种方式处理：

• 按文件日期清理旧数据：从文件名R_Data_YYYY_MM_DD中提取日期，先删除Tested表中对应日期的记录，再插入新统计结果：

  ' 提取文件名中的日期部分
  Dim fileDate As String
  fileDate = Mid(file_name, 8, 10) ' 从第8位开始取10位（YYYY_MM_DD）
  ' 转换为表中Date字段的格式（假设是短日期）
  fileDate = Replace(fileDate, "_", "-")
  ' 删除旧数据
  db.Execute "DELETE FROM Tested WHERE Date = #" & fileDate & "#"
  

• UPSERT逻辑（更新+插入）：先更新已存在的Date/Lot/Part组合的统计值，再插入新增的组合，避免全量删除：

  -- 先更新已有记录
  UPDATE Tested t
  INNER JOIN (
      SELECT [Date], [Lot], [Part],
             SUM(IIF(Test1='NOK',1,0)) AS Test1_NOK,
             SUM(IIF(Test2='NOK',1,0)) AS Test2_NOK,
             COUNT(*) AS Total
      FROM [临时表名]
      GROUP BY [Date], [Lot], [Part]
  ) s ON t.Date = s.Date AND t.Lot = s.Lot AND t.Part = s.Part
  SET t.Test1 = s.Test1_NOK, t.Test2 = s.Test2_NOK, t.Total = s.Total;
  
  -- 再插入新增记录
  INSERT INTO Tested ([Date], [Lot], [Part], Test1, Test2, Total)
  SELECT s.[Date], s.[Lot], s.[Part], s.Test1_NOK, s.Test2_NOK, s.Total
  FROM (
      SELECT [Date], [Lot], [Part],
             SUM(IIF(Test1='NOK',1,0)) AS Test1_NOK,
             SUM(IIF(Test2='NOK',1,0)) AS Test2_NOK,
             COUNT(*) AS Total
      FROM [临时表名]
      GROUP BY [Date], [Lot], [Part]
  ) s
  LEFT JOIN Tested t ON t.Date = s.Date AND t.Lot = s.Lot AND t.Part = s.Part
  WHERE t.Date IS NULL;
  

2. 清理临时表，避免数据库膨胀 #

现有代码导入每个CSV为单独的表但未删除，处理完后需删除临时表：

' 在执行完INSERT后添加
DoCmd.DeleteObject acTable, Replace(file_name, ".csv", "")

3. 修正SQL统计逻辑的字段匹配错误 #

现有SQL中使用了Leak、Camera字段，但实际CSV中是Test1、Test2，需修正统计逻辑，同时处理Test2中的-值：

strSQL = "INSERT INTO [Tested] ([Date], [Lot], [Part], [Test1_NOK], [Test2_NOK], [Total]) " & _
         "SELECT [Date], [Lot], [Part], " & _
         "SUM(IIF(Test1 = 'NOK', 1, 0)) AS Test1_NOK, " & _
         "SUM(IIF(Test2 = 'NOK', 1, 0)) AS Test2_NOK, " & _
         "COUNT(*) AS [Total] " & _
         "FROM [" & Replace(file_name, ".csv", "") & "] " & _
         "GROUP BY [Date], [Lot], [Part]"

4. 提升大文件处理性能 #

• 关闭Access的警告和自动刷新，减少卡顿：

  DoCmd.SetWarnings False
  ' 导入和处理代码块
  DoCmd.SetWarnings True
  

• 给Tested表的Date、Lot、Part字段建立复合主键或复合索引，加速查询、更新和删除操作。

5. 增加错误处理，避免异常中断 #

给VBA代码添加错误捕获，防止中途出错导致数据残留：

Public Function Import_files()
    Dim report_path As String, file_name As String
    Dim db As DAO.Database
    Dim strSQL As String

    On Error GoTo ErrorHandler
    DoCmd.SetWarnings False
    Set db = CurrentDb
    report_path = "C:\documents\"
    file_name = Dir(report_path & "*.csv", vbDirectory)

    Do While file_name <> vbNullString
        ' 导入、统计、删除临时表代码
        file_name = Dir
    Loop

ExitHandler:
    DoCmd.SetWarnings True
    MsgBox "数据处理完成", vbInformation
    Set db = Nothing
    Exit Function

ErrorHandler:
    MsgBox "处理出错：" & Err.Description, vbCritical
    Resume ExitHandler
End Function

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