按10分钟间隔筛选CSV数据并复制至XLSM的Sheet1技术需求

需求说明 #

我有两个文件：TEST.csv和TEST.xlsm，路径均为C:\Users\WS035\Desktop\MACRO\TEST2。需要将.csv文件中B列时间为10分钟间隔（原数据为5秒间隔记录）的整行数据，复制到.xlsm文件的Sheet1工作表中。

原始代码问题分析 #

你提供的代码核心逻辑存在错误，导致无法正确筛选10分钟间隔的数据：

• 时间判断条件Hour(currentTime) Mod 10 = 0 And Minute(currentTime) = 0 And Second(currentTime) = 0仅会提取整10小时的整点（如10:00:00、20:00:00），而非每10分钟一次的记录（如00:10:00、00:20:00）。
• 未关闭打开的工作簿，可能造成文件占用或意外错误。
• 未保留源文件的表头，直接从第2行数据开始覆盖目标表第1行。
• 未处理文件打开失败的异常情况，程序容错性差。

优化后的代码 #

Sub FilterAndCopyDataIn10MinuteIntervals()
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceFilePath As String
    Dim targetFilePath As String
    Dim lastRow As Long
    Dim currentRow As Long
    Dim targetRow As Long
    Dim currentTime As Variant
    
    ' 定义文件路径
    sourceFilePath = "C:\Users\WS035\Desktop\MACRO\TEST2\TEST.csv"
    targetFilePath = "C:\Users\WS035\Desktop\MACRO\TEST2\TEST.xlsm"
    
    ' 错误处理：捕获文件打开等异常
    On Error GoTo ErrorHandler
    
    ' 打开源文件（CSV）
    Set sourceWB = Workbooks.Open(sourceFilePath)
    Set sourceSheet = sourceWB.Sheets(1)
    
    ' 打开目标文件（XLSM）
    Set targetWB = Workbooks.Open(targetFilePath)
    Set targetSheet = targetWB.Sheets("Sheet1")
    
    ' 清空目标表原有数据（保留格式）
    targetSheet.UsedRange.ClearContents
    
    ' 复制源文件表头到目标表
    sourceSheet.Rows(1).Copy targetSheet.Rows(1)
    targetRow = 2 ' 目标数据起始行
    
    ' 获取源文件B列最后一行数据
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row
    
    ' 循环筛选10分钟间隔数据
    For currentRow = 2 To lastRow
        currentTime = sourceSheet.Cells(currentRow, 2).Value
        
        ' 验证是否为有效时间格式
        If IsDate(currentTime) Then
            currentTime = TimeValue(currentTime)
            
            ' 正确判断10分钟间隔：分钟为10的倍数且秒数为0
            If (Minute(currentTime) Mod 10 = 0) And (Second(currentTime) = 0) Then
                ' 复制整行到目标表
                sourceSheet.Rows(currentRow).Copy targetSheet.Rows(targetRow)
                targetRow = targetRow + 1
            End If
        End If
    Next currentRow
    
    ' 保存并关闭工作簿
    targetWB.Save
    sourceWB.Close SaveChanges:=False ' CSV文件无需保存
    targetWB.Close SaveChanges:=False ' 已保存过，无需重复保存
    
    MsgBox "10分钟间隔数据已筛选并复制完成。"
    Exit Sub
    
ErrorHandler:
    MsgBox "操作出错：" & Err.Description, vbCritical
    ' 清理已打开的工作簿
    If Not sourceWB Is Nothing Then sourceWB.Close SaveChanges:=False
    If Not targetWB Is Nothing Then targetWB.Close SaveChanges:=False
End Sub

关键优化点 #

• 修正时间筛选逻辑：改为判断分钟数是否为10的倍数且秒数为0，精准匹配10分钟间隔的记录（如00:00:00、00:10:00等）。
• 保留表头结构：先复制源文件表头到目标表，保证数据结构完整。
• 添加异常处理：捕获文件打开失败等错误，避免程序崩溃并自动清理资源。
• 优化资源管理：操作完成后关闭所有工作簿，释放文件占用。

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