用于输入没有“/”的日期的私人子工作表_更改在输入 3 个日期后意外停止运行

Question

我正在尝试编写一个简单的代码，可以使数据输入更快一些。用户应该能够输入 13 表示 1 月 3 日、22 表示 2 月 2 日、310 表示 3 月 10 日、1005 表示 10 月 5 日、1220 表示 12 月 20 日。所有日期都将使用今天的年份。

该代码似乎已损坏，但仍然可以运行，只是在按 3 个单元的预期执行后出现错误。然后，如果我删除该列或重新加载工作簿，它会再次按预期工作，但仅适用于前 3 个单元格。

通过静态函数，只是错误地将 13 视为 1990 年 1 月 13 日； 22 为 1990 年 1 月 22 日； 310为1990年的第310天； 1005 为 1899 年 12 月 31 日后的第 1,220 天；等等

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C:C"), Target) Is Nothing Then
        If Selection.Count > 1 Then
            Exit Sub
        End If

        TLen = Len(Target)
        DaV = Target

        If TLen = 2 Then
            DaV = DateSerial(Year(Now), Left(Target, 1), Right(Target, 1))
        ElseIf TLen = 3 Then
            DaV = DateSerial(Year(Now), Left(Target, 1), Right(Target, 2))
        ElseIf TLen = 4 Then
            DaV = DateSerial(Year(Now), Left(Target, 2), Right(Target, 2))
        Else
            Exit Sub
        End If

        Application.EnableEvents = False
        Target = DaV
        Target.NumberFormat = "yyyy-mm-dd"
        Application.EnableEvents = True
    End If
End Sub

Answer 1

解释

代码的主要问题是您使用的是

.Value

而不是

.Value2

您可能想阅读 .text、.value 和 .value2 之间有什么区别？

问题是当您设置单元格格式时，Excel 会自动将格式复制到其下面的下一个单元格。由于您使用的是

.Value

，代码会选取格式化的值

因此，如果您在代码中的

TLen = Len(Target)

处放置断点，您将得到

10

，而不是

4

的

1005

。如果您使用

.Value2

，您将得到

4

，而不是

10

或

5(For Date stored as number)

。

我还添加了一些检查。

我已经对代码进行了注释，因此您应该不会在理解它时遇到问题。如果您仍然这样做，请告诉我。

代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    '~~> Error Handling
    On Error GoTo Whoa
    
    '~~> Check if there is more than one cell was changed
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    Dim D As Long, M As Long
    Dim TLen As Long
    Dim dt As String
    Dim FinalDate As Date
    
    '~~> Check if the change happened in column C
    If Not Intersect(Columns(3), Target) Is Nothing Then
        '~~> Get the value of changed cell
        dt = Target.Value2
        '~~> Get the length
        TLen = Len(dt)
        
        '~~> String check
        If Not IsNumeric(Target.Value2) Then GoTo Letscontinue
        
        '~~> FIRST CHECK: If the length is not as expected do nothing
        If TLen < 2 Or TLen > 4 Then GoTo GoToFormatAndExit
        
        '~~> Get the date and month
        Select Case TLen
            Case 2
                D = Right(dt, 1)
                M = Left(dt, 1)
            Case 3
                D = Right(dt, 2)
                M = Left(dt, 1)
            Case 4
                D = Right(dt, 2)
                M = Left(dt, 2)
        End Select
        
        '~~> FEW CHECKS: TO get correct dates
        '~~> Month more than 12
        If M > 12 Then GoTo GoToFormatAndExit
        '~~> Date more than 31
        If D > 31 Then GoTo GoToFormatAndExit
        '~~> Leap year
        If D > 28 And M = 2 And isLeapYear(Year(Now)) Then GoTo GoToFormatAndExit
        
        '~~> Construct final date
        FinalDate = DateSerial(Year(Now), M, D)
        
        '~~> Check if Excel created an incorrect date
        If Year(FinalDate) <> Year(Now) Then GoTo GoToFormatAndExit
        
        Target = FinalDate
        Target.NumberFormat = "yyyy-mm-dd"
    End If
    
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
    
GoToFormatAndExit:
    Application.EnableEvents = True
    '~~> Excel changes the format so keep it as general
    Target.NumberFormat = "General"
    Exit Sub
    
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Public Function isLeapYear(Yr As Integer) As Boolean
    isLeapYear = (Month(DateSerial(Yr, 2, 29)) = 2)
End Function

在行动

免责声明：

我可能还错过了一些检查，因为我还没有对此进行彻底测试。请随意即兴编写代码。