好吧,这是我的答案。正如@NicholasHunter 所说,Option Explicit
总是更好!很明显你想通了,但是考虑一下这个答案,无论如何希望对其他人有所帮助。
Option Explicit
Sub times()
'Here you can validate the format date type for your system...
Dim SystemDateType As Integer
Dim SysFormatDate As String
' 0 = m-d-y
' 1 = d-m-y
' 2 = y-m-d
If Application.International(xlDateOrder) = 0 Then
SystemDateType = 0
SysFormatDate = "mm/dd/yyyy"
ElseIf Application.International(xlDateOrder) = 1 Then
SystemDateType = 1
SysFormatDate = "dd/mm/yyyy"
ElseIf Application.International(xlDateOrder) = 2 Then
SystemDateType = 2
SysFormatDate = "yyyy/mm/dd"
End If
'Of course you can do this:
'SystemDateType = Application.International(xlDateOrder)
'Or just use a Select Case...
'But just want to be clear and set the variable SysFormatDate
Dim StopedByUser As String: StopedByUser = "StopedByUser"
'Here you can define your own message.
Dim d1 As Date
'Look for the DateSerial function
Dim d2 As Variant
'This could be Long, but just want to set a data type
Dim ErrHandler As Integer
Dim n As Variant
'Or maybe String?
Dim entered_date As Date
'alwayes respect Data Types...
RetryInput:
n = Application.InputBox("Enter a date in " & SysFormatDate & " format: ")
'The user input...
'Cancel...
If n = False Then
MsgBox StopedByUser
End
End If
'Error Handler!
If IsDate(n) Then 'If the user input a real date...
entered_date = CDate(entered_date)
d1 = DateSerial(2011, 11, 16) ' ==> YYYY, MM, DD
'It is always better to use DateSerial!
'And hard coded... Well hope is just your for the question.
'd1 = 5 / 11 / 2021
If d1 >= entered_date Then
'The >= and <= are better in this case...
d2 = DateDiff("D", d1, entered_date)
MsgBox ("late by " & Abs(d2)) 'Abs return the absolute value, instead -321 return 321.
Else
MsgBox ("on time")
End If
Else 'If the user don't know what is a date...
'ask the user... want to try again...
ErrHandler = MsgBox("Please enter a formated date (" & SysFormatDate & ")", vbDefaultButton1 + vbYesNo, "Retry")
If ErrHandler = 7 Then '7 is NO
MsgBox StopedByUser
End
ElseIf ErrHandler = 6 Then '6 is YES and go back in the code to...
GoTo RetryInput
End If
'Check for MSGBOX here: https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/msgbox-function
End If
End Sub