VBA脚本需求：复制时长超00:40:00的Lunch Break记录及格式问题

你的VBA脚本核心问题出在时长比较逻辑上：你直接将单元格的时间值与字符串 "00:40:00" 做对比，但Excel中时间本质是代表天数的小数（例如40分钟等于 40/(24*60)=1/36≈0.027778），字符串比较会按字符顺序判断，结果完全不准确。

另外，脚本里频繁使用 Activate 和 Select 方法会拖慢运行效率，也容易引发错误，建议直接通过工作表对象引用操作。

修正后的代码 #

Sub Long_Lunch()
    Dim wsRaw As Worksheet, wsDest As Worksheet
    Dim lastRow As Long, destRow As Long
    Dim i As Long
    
    ' 定义工作表对象，避免重复引用
    Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
    Set wsDest = ThisWorkbook.Worksheets("D")
    
    lastRow = wsRaw.Cells(wsRaw.Rows.Count, 1).End(xlUp).Row
    destRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1 ' 初始目标行
    
    For i = 2 To lastRow
        ' 先判断类别，再用TimeValue转换时间进行数值比较
        If wsRaw.Cells(i, 4).Value = "Lunch Break" Then
            If wsRaw.Cells(i, 6).Value > TimeValue("00:40:00") Then
                wsRaw.Rows(i).Copy Destination:=wsDest.Cells(destRow, 1)
                destRow = destRow + 1 ' 更新目标行
            End If
        End If
    Next i
    
    Application.CutCopyMode = False
    wsRaw.Activate
    wsRaw.Cells(1, 1).Select
    MsgBox "Done"
End Sub

关键修改说明 #

• 用 TimeValue("00:40:00") 将字符串转换为Excel可识别的时间数值，确保比较逻辑正确
• 定义工作表对象变量，减少重复调用 Worksheets() 的开销
• 使用 Copy Destination:= 直接指定粘贴位置，去掉不必要的 Activate 和 Select 操作，提升运行效率
• 提前初始化目标行变量，避免每次循环都重新计算，进一步优化性能

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