Excel VBA日期时间调整求助：保留时间更新日期，跨次日时间异常

问题根源 #

你之前使用的公式=TEXT(cel,"hh:mm") + Today()仅提取时间部分并直接叠加当前日期，未区分右表中属于次日凌晨（00:00-04:30）的时间区间，导致这部分时间被错误设置为当前日凌晨，而非当前日的次日凌晨。

解决方案 #

放弃公式赋值，直接在VBA中通过判断时间区间计算正确的日期时间值，精准度和效率更高：

1. 处理左表（08:00-18:30时段）

保留原时间，将日期替换为当前日期：

' 替换LeftRange为你的左表实际单元格范围，例如Sheet1.Range("A2:A100")
For Each cel In LeftRange
    If IsDate(cel.Value) Then ' 仅处理日期类型单元格
        cel.Value = Date + TimeValue(cel.Value)
        cel.NumberFormat = "yyyy/mm/dd hh:mm" ' 设置显示格式
    End If
Next cel

2. 处理右表（18:30-次日04:30时段）

根据原时间区间判断日期：

' 替换RightRange为你的右表实际单元格范围，例如Sheet2.Range("A2:A100")
Dim t As Date
For Each cel In RightRange
    If IsDate(cel.Value) Then
        t = TimeValue(cel.Value) ' 提取纯时间部分
        If t <= TimeValue("04:30:00") Then
            ' 凌晨00:00-04:30，日期设为当前日+1
            cel.Value = Date + 1 + t
        Else
            ' 18:30-23:59，日期设为当前日
            cel.Value = Date + t
        End If
        cel.NumberFormat = "yyyy/mm/dd hh:mm" ' 设置显示格式
    End If
Next cel

3. 整合到WorkBook_Open事件

将代码放入工作簿打开事件中，实现自动更新：

Private Sub Workbook_Open()
    Dim LeftRange As Range, RightRange As Range
    ' 替换为你的表格实际范围
    Set LeftRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A100")
    Set RightRange = ThisWorkbook.Sheets("Sheet2").Range("A2:A100")
    
    ' 处理左表
    For Each cel In LeftRange
        If IsDate(cel.Value) Then
            cel.Value = Date + TimeValue(cel.Value)
            cel.NumberFormat = "yyyy/mm/dd hh:mm"
        End If
    Next cel
    
    ' 处理右表
    Dim t As Date
    For Each cel In RightRange
        If IsDate(cel.Value) Then
            t = TimeValue(cel.Value)
            If t <= TimeValue("04:30:00") Then
                cel.Value = Date + 1 + t
            Else
                cel.Value = Date + t
            End If
            cel.NumberFormat = "yyyy/mm/dd hh:mm"
        End If
    Next cel
End Sub

关键说明 #

• TimeValue(cel.Value)：提取单元格中的纯时间部分，忽略原日期
• Date：返回当前系统日期，无时间部分
• IsDate(cel.Value)：避免非日期类型单元格引发报错
• 设置NumberFormat确保单元格以正确的日期时间格式显示

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