此代码允许使用Excel内置数据验证方法无法使用的几个功能：
1.一个单元格中可以添加多个日期值
1.只允许指定范围内的日期值
1.如果用户添加了不正确的值（例如：不是日期的值，或者日期福尔斯指定范围），则代码将退出单元格编辑，而不修改单元格中的原始值。
我创建了两个变量dtStart和dtEnd，它们包含了我想用于日期验证的开始日期和结束日期。
我将这些变量添加到了工作表更改事件sub中。
dtEnd很特殊，因为它调用dtToday，dtToday检索今天的日期，我想在日期范围验证中使用它。
我的大部分代码来自this website，它最初是为了允许用户覆盖excel的数据验证方法，允许从数据验证列表中选择多个项，并删除重复项而编写的。我修改了这段代码，以便随后检查值是否为日期，然后检查该日期是否福尔斯指定的范围内。
下面是函数代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OldVal As String 'original cell value before edit
    Dim NewVal As String 'new value entered by user
    Dim dtStart As Date 'start value as date, for date range validation
    Dim dtEnd As Date 'end value as date, for date range validation
    dtStart = #1/1/2000# 'set a start date
    dtEnd = Date 'get today's date and set it as the end date
    
    
    
    ' If more than 1 cell is being changed
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    If Not Intersect(Target, ActiveSheet.Range("stack_vba_testing")) Is Nothing Then
    
        ' Turn off events so our changes don't trigger this event again
        Application.EnableEvents = False
        
        ' store the selected date into a value called "NewVal"
        NewVal = Target.Value
        
        ' If there's nothing to undo this will cause an error
        On Error Resume Next
        
        'we don't want the new value to take over the cell, so undo adding the new value
        Application.Undo
        On Error GoTo 0
        
        'because of application.undo, we can access the original cell value. store that as "OldVal"
        OldVal = Target.Value
        
        'Before starting, reformat NewVal to dd mm yyyy, because excel does weird things when / is used to seperate mm dd yyyy
        NewVal = Format(NewVal, "dd mm yyyy")

        'check if oldval contains newval
        If InStr(OldVal, NewVal) Then
        
            'Check if there is a comma in the cell, which would indicate that there is more than one value in the cell
            If InStr(OldVal, ",") Then
            
                'Then check if the oldval contains a comma *followed by* the new val
                If InStr(OldVal, ", " & NewVal) Then
                    
                    'then remove the comma and the value; replace with an empty space
                    Target.Value = Replace(OldVal, ", " & NewVal, "")
                   
                
                Else
                'Else, if old val contains new val but ends witha comma (instead of starting with a comma)
                
                    'then replace the value (which ends with a comma) with an empty space
                    Target.Value = Replace(OldVal, NewVal & ", ", "")
                    
                    
                
                End If
                
            Else
            
                'Else, old val was equal to new val without anything else in the cell, so make the cell = nothing
                Target.Value = ""
            
            End If
        
        Else
            'Check if old value = nothing/empty
            If OldVal = "" Then 'check if oldval is empty
                
                If IsDate(NewVal) Then 'if old val is empty, check if new val is a date
                    
                    If NewVal >= dtStart And NewVal <= dtEnd Then 'if newval is a date, check if it falls within date range
                        Target.Value = Format(NewVal, "dd mm yyyy") 'if new val is a date, make the cell = newval
                    
                    Else
                    
                    MsgBox ("Date is out of range (01/01/2000 and Today)")
                    
                    End If
                
                Else
                    MsgBox ("Not a date") 'otherwise, throw error message
                    Target.Value = OldVal 'and keep original cell contents
                    
                End If
                
                
            Else
            
                'If the new value = nothing, then make the cell = nothing
                If NewVal = "" Then
            
                    
                    Target.Value = ""
                    
                    
                
                Else
            
                    'Check if the old value (target) are different
                    If InStr(Target.Value, NewVal) = 0 Then
                        
                        If IsDate(NewVal) Then 'if they are different check if newval is a date value
                            
                            If NewVal >= dtStart And NewVal <= dtEnd Then 'if newval is a date, check if it falls within date range
                            Target.Value = OldVal & ", " & Format(NewVal, "dd mm yyyy") 'if date falls within specified range, concatenate newval and oldval using a comma
                            
                            Else
                                MsgBox ("Date out of range")
                                
                            End If
                            
                        Else
                            MsgBox ("Not a date") 'if new val is not a date, throw error message
                            Target.Value = OldVal 'and keep original cell value
                            
                        End If
                        
                
                    End If
                
                End If
            
            End If
            
        End If
        
        Application.EnableEvents = True
            
    Else
    
        Exit Sub
        
    End If
    

End Sub