Question

我正在尝试验证在用户表单上输入文本框的日期。当我输入例如23/7/15时，代码工作正常并给我一个值，因为输入的日期是有效的，当我输入32/7/2015时，我收到一条消息，我编程告诉用户他们输入了错误date，但如果我输入32/7/15，它会将代码中的日期设置为1932年的某个日期，因为这是一个有效的日期，所以它不会抛出错误。下面是我正在使用的代码。无论如何都要验证32/7/15？

Private Function errorCheckingDate(box1, message) As Boolean '<============= Returns a True or a False
    If Not IsDate(box1) Then '<============================================= Checks to see if entered value is date or not
        MsgBox message, vbExclamation, "Invalid Selection" '<=============== Displays a messgae box if not date
        box1.SetFocus '<==================================================== Puts cursor back to the offending box
        errorCheckingDate = True '<========================================= Sets function to True
    End If
End Function

box1只是文本框转换为日期后的值。以下是转换

        secondSelectedStr = Format(DateTextBox.value, "dd-mm-yy") '<===== Convert to correct format

任何帮助都会很棒。

Answer 1

也许您可以使用自己的自定义函数代替使用IsDate。

Function isValidDate(d as String) as Boolean
Dim parts as Variant
Dim months29 as variant
Dim months30 as variant
Dim months31 as variant
months29 = Array(2)
months30 = Array(4, 6, 9, 11)
months31 = Array(1, 3, 5, 7, 8, 10, 12)
parts = Split(d, "-")
if parts(2) mod 4 = 0 then
    daysLeapYear = 28
else:
    daysLeapYear = 29
end if
if ((IsInArray(parts(0), months29) and parts(1) <= daysLeapYear) or _
   (IsInArray(parts(0), months30) and parts(1) < 31) or _
   (IsInArray(parts(0), months31) and parts(1) < 32)) and _
    parts(2) < 16 then
        isValidDate = True
else:
        isValidDate = False
end if
end function

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

这应该涵盖大多数情况。不确定你觉得你需要多么详细。 IsInArray由@JimmyPena提供。

Answer 2

除订购问题外，VBA还会尝试将无效的日期范围调整到合适的日期。例如，这一直是获得一年中X日的简洁技术：

d = DateSerial(2015, 1, X)

X在这里可以是任何数字（当然，达到数据类型的限制）。如果X为500，则会生成日期2016-5-14。因此，mm/dd vs dd/mm vs yy/mm/dd问题加上 VBA接受有效范围之外的数字这一事实都很麻烦。

如果没有范围检查每个日期组件（您必须考虑闰年等等），我认为最好的解决方案是让VBA创建您的日期，然后对其进行测试以确保它是您的＆＃39期待。例如：

' Get the date components (assuming d/m/yy)...
Dim a As Variant
a = Split(strDate, "/")

' Need 3 components...
If UBound(a) <> 2 Then MsgBox "Invalid date": Exit Sub

' Create the date. This will hardly ever fail. 
' VBA will create some kind of date using whatever numbers you throw at it.
Dim d As Date
d = DateSerial(a(2), a(1), a(0))

' Make sure the date VBA created matches what we expected...
If Day(d) <> CInt(a(0)) Then MsgBox "Invalid day": Exit Sub
If Month(d) <> CInt(a(1)) Then MsgBox "Invalid month": Exit Sub
If Right$(Year(d), 2) <> a(2) Then MsgBox "Invalid year": Exit Sub

你可以把它扔进一个子程序（你可能已经注意到Exit Sub语句）来验证输入的日期。 TextBox_Exit事件会很好用。这样，您可以设置Cancel = True以防止用户使用无效日期离开文本框。

Answer 3

感谢答案的人，但我需要适应闰年和其他事情。由于isdate函数在2015年1月1日输入日期时有效，我刚刚使用len()函数确保输入的日期具有一定的长度。下面是我使用的代码。再次感谢您的帮助。：）

Private Function errorCheckingDate(box1, message) As Boolean '<============= Returns a True or a False
If Not IsDate(box1) Or Len(box1) < 8 Or Len(box1) > 10 Then '<============================================= Checks to see if entered value is date or not
    MsgBox message, vbExclamation, "Invalid Selection" '<=============== Displays a messgae box if not date
    box1.SetFocus '<==================================================== Puts cursor back to the offending box
    errorCheckingDate = True '<========================================= Sets function to True
End If
End Function

日期验证无法正常工作

3 个答案: