VBA新手求助：同行列值相减批量计算及实时更新计时器实现

修正后的时间差计算代码 #

Sub TimeCalcs()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Downtime") '用ThisWorkbook避免工作簿名称变更导致报错
    
    Dim startTimeCol As Range, endTimeCol As Range, durationCol As Range
    Set startTimeCol = ws.Range("StartTimeRange") '对应B16:B50
    Set endTimeCol = ws.Range("EndTimeRange") '对应H16:H50
    Set durationCol = ws.Range("DurationRange")
    
    Dim i As Long
    '逐行遍历，确保每行的时间单元格与结果单元格一一对应
    For i = 1 To startTimeCol.Rows.Count
        Dim startCell As Range, endCell As Range, durCell As Range
        Set startCell = startTimeCol.Cells(i, 1)
        Set endCell = endTimeCol.Cells(i, 1)
        Set durCell = durationCol.Cells(i, 1)
        
        '仅当当前行的两个时间单元格都不为空时计算
        If Not IsEmpty(startCell.Value) And Not IsEmpty(endCell.Value) Then
            durCell.Value = endCell.Value - startCell.Value
            durCell.NumberFormat = "[h]:mm:ss" '设置跨天时间差的显示格式
        Else
            durCell.ClearContents '空值时清空结果单元格
        End If
    Next i
End Sub

原代码核心问题说明 #

• 直接操作整个StartTimeRange/EndTimeRange范围，未关联到循环的单行单元格，导致所有行计算结果重复
• IsEmpty(StartTimeRange)判断的是整个区域是否为空，而非当前行的单个单元格，逻辑错误
• 使用固定工作簿名称引用不如ThisWorkbook稳定，易受工作簿重命名影响

自动更新计时器实现 #

在Downtime工作表的代码模块中添加以下事件代码，实现修改时间值时自动重新计算：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim watchRanges As Range
    Set watchRanges = Union(Me.Range("StartTimeRange"), Me.Range("EndTimeRange"))
    
    '判断修改的单元格是否在时间数据范围内
    If Not Intersect(Target, watchRanges) Is Nothing Then
        TimeCalcs '触发计算宏
    End If
End Sub

注意事项 #

• 确保StartTimeRange、EndTimeRange、DurationRange三个命名区域的行数完全一致，避免下标越界错误
• 若需手动触发计算，可将TimeCalcs宏绑定到工作表按钮上
• 时间差跨天时，[h]:mm:ss格式会显示累计小时数，而非重置为0

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