Mac Excel 2016 VBA用户窗体：严格验证dd/mmm/yy格式日期

要搞定dd/mmm/yy格式的严格验证，得避开CDate/DateValue自动转错的坑，分两步走：先卡文本格式，再验日期真实性，最后锁死窗体不让随便关。

一、先把输入格式卡死（正则匹配） #

用正则表达式确保输入严格符合数字日/三位英文月缩写/两位年的格式，直接拒绝6/Fbc/21这种瞎编的月份，或者位数不对的情况。

VBA代码：

Function IsDateFormatValid(inputStr As String) As Boolean
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    ' 正则规则：日是1-2位（01-31），月份是Jan-Dec严格匹配，年份2位数字
    regEx.Pattern = "^(0?[1-9]|[12][0-9]|3[01])\/(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\/\d{2}$"
    regEx.IgnoreCase = False ' 要兼容大小写就改成True
    IsDateFormatValid = regEx.Test(inputStr)
End Function

二、验证日期是真实存在的 #

格式对了还不够，得确保是真实存在的日期——比如30/Feb/20、41/Jan/19这种无效的要揪出来。这里不能直接转日期，得拆成日/月/年单独验证：

Function IsDateValid(inputStr As String) As Boolean
    Dim inputDay As Integer, inputMonth As Integer, inputYear As Integer
    Dim parsedDate As Date
    Dim parts() As String
    
    parts = Split(inputStr, "/")
    inputDay = CInt(parts(0))
    ' 用2000年（闰年）获取月份对应的数字，避免平年闰年影响判断
    inputMonth = Month(DateValue("1 " & parts(1) & " 2000"))
    ' 默认2位年对应20xx，要兼容19xx就加后续判断
    inputYear = 2000 + CInt(parts(2))
    
    ' 尝试生成日期，失败就是无效日期
    On Error Resume Next
    parsedDate = DateSerial(inputYear, inputMonth, inputDay)
    On Error GoTo 0
    
    ' 关键：生成的日期必须和原输入的日/月/年完全一致，防止41/Jan/19被转成19/1/41这种情况
    If IsDate(parsedDate) Then
        IsDateValid = (Day(parsedDate) = inputDay And Month(parsedDate) = inputMonth And Year(parsedDate) = inputYear)
    Else
        IsDateValid = False
    End If
End Function

三、锁死窗体，不填对不让关 #

在用户窗体里加两个事件，实现实时验证+阻止关闭：

1. 文本框离开时的实时提示 #

Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsDateFormatValid(txtDate.Value) Or Not IsDateValid(txtDate.Value) Then
        MsgBox "请输入有效的dd/mmm/yy格式日期，比如：01/Jan/23", vbCritical
        Cancel = True ' 不让离开这个文本框
        txtDate.SetFocus
        txtDate.SelStart = 0
        txtDate.SelLength = Len(txtDate.Value) ' 选中错误内容方便修改
    End If
End Sub

2. 点叉号关闭时阻止 #

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' 只有点右上角叉号时触发
    If CloseMode = vbFormControlMenu Then
        If Not IsDateFormatValid(txtDate.Value) Or Not IsDateValid(txtDate.Value) Then
            MsgBox "必须输入有效的dd/mmm/yy格式日期才能关闭窗体", vbCritical
            Cancel = True ' 阻止关闭
            txtDate.SetFocus
        End If
    End If
End Sub

额外调整说明 #

• 年份兼容：如果要支持19xx（比如00-49算20xx，50-99算19xx），修改inputYear的代码：

  inputYear = CInt(parts(2))
  inputYear = IIf(inputYear >= 50, 1900 + inputYear, 2000 + inputYear)
  

• Mac兼容性：VBScript.RegExp在Mac Excel 2016里可用，如果出问题，就把月份判断改成列表匹配：

  ' 替换正则里的月份验证逻辑
  IsDateFormatValid = (InStr("JanFebMarAprMayJunJulAugSepOctNovDec", parts(1)) > 0) And ' 其他格式判断
  

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