VBA日期转换代码异常：删除单元格内容自动变为7月31日

问题场景 #

在A1:A10单元格输入日（如23）回车，期望自动转换为当前年月的日期（如23-August-2024），避免Excel默认的1990年1月日期。但删除输入过日期的单元格内容时，单元格不会清空，反而自动变为上月最后一天（如7月31日）。

原代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, rint As Range, r As Range
    Set rng = Range("A1:A10")
    Set rint = Intersect(rng, Target)

    For Each r In rint
        Application.EnableEvents = False
            r.Value = DateSerial(Year(Date), Month(Date), r.Value)
        Application.EnableEvents = True
    Next r
End Sub

问题根源 #

删除单元格内容时，r.Value会变为0，而DateSerial(year, month, 0)的特性是返回指定月份的上一个月最后一天，这就导致了删除操作后出现异常日期。

修复后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, rint As Range, r As Range
    Dim currentYear As Integer, currentMonth As Integer, maxMonthDay As Integer
    
    Set rng = Range("A1:A10")
    Set rint = Intersect(rng, Target)
    
    ' 若修改区域不在目标范围内，直接退出
    If rint Is Nothing Then Exit Sub
    
    currentYear = Year(Date)
    currentMonth = Month(Date)
    ' 计算当前月份的最大天数（用下月第一天减1天的方式获取）
    maxMonthDay = Day(DateSerial(currentYear, currentMonth + 1, 0))
    
    For Each r In rint
        Application.EnableEvents = False
            ' 仅当输入为1到当月最大天数之间的有效数字时，执行日期转换
            If IsNumeric(r.Value) And r.Value >= 1 And r.Value <= maxMonthDay Then
                r.Value = DateSerial(currentYear, currentMonth, r.Value)
            Else
                ' 输入无效/删除内容时，清空单元格
                r.ClearContents
            End If
        Application.EnableEvents = True
    Next r
End Sub

修复要点 #

• 新增当月最大天数校验，避免输入超过当月天数的无效值（如2月输入30）
• 增加判断逻辑：仅处理有效日期天数输入，其他情况（删除、非数字、无效天数）直接清空单元格
• 加入rint Is Nothing判断，减少不必要的循环，优化代码执行效率

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