收件箱日期验证

Question

我有下面的代码，如果用户添加日期，它可以正常工作，但如果他添加数字，例如1或66，而不是日期，代码仍然运行并删除所有列。我似乎无法解决这个问题。

Sub deleteCols()
Dim early As Date
Dim late As Date
Dim lc As Long
Dim i As Long
Application.ScreenUpdating = False
On Error GoTo Errorhandler
early = CDate(Application.InputBox(Prompt:="Please enter start date:", Type:=2))
late = CDate(Application.InputBox(Prompt:="Please enter end date:", Type:=2))

If early = 0 Then Exit Sub
If late = 0 Then Exit Sub

lc = Cells(1, Columns.Count).End(xlToLeft).Column
For i = lc To 8 Step -1
If Cells(1, i) < early Then
Cells(1, i).EntireColumn.delete
ElseIf Cells(1, i) > late Then
Cells(1, i).EntireColumn.delete
Else
End If
Next i
Application.ScreenUpdating = True
Exit Sub
Errorhandler:
MsgBox "You need to insert a date dd/mm/yyyy"
Resume
End Sub

Answer 1

InputBox不是收集用户日期输入的最佳方式。使用日期选择器控件。有很多帖子讨论如何将日期添加到自定义表单中，比如：在VBA 中的文本框中格式化MM/DD/YYYY日期

您也可以从工作表中的日期格式单元格中提取日期。

在收到用户输入的日期后，您仍然需要进行一些健全性检查，以确保输入的日期有效。这完全取决于你的要求。也许用户应该只能选择过去的时间，或者只能选择未来的时间，或只能选择某个范围内的时间。至少您应该检查null或0。

我们不能为你写这个。只有你知道你的要求。

请注意，1和66是有效日期，因为日期是自时间开始以来的天数。在VBA的情况下：

? CDate(1)
12/31/1899 
? CDate(66)
3/6/1900 

我以为时间的开始是1900年，但看起来它是从1899年最后一天的午夜开始的。

Answer 2

您可以使用以下函数进行检查

Option Explicit
Enum enumCmp
le
ge
End Enum
Function checkDate(inpDt As Date, checkDt As Date, cp As enumCmp) As Boolean
On Error GoTo EH

If cp = enumCmp.le Then
checkDate = inpDt <= checkDt
ElseIf cp = enumCmp.ge Then
checkDate = inpDt >= checkDt
End If

Exit Function

EH:
' just use the default
End Function

测试可能看起来像

Sub TestIt()

Const EARLIEST = #1/1/2000#
Dim early As Date
Dim late As Date

On Error GoTo EH

early = CDate(Application.InputBox(Prompt:="Please enter start date:", Type:=2))
late = CDate(Application.InputBox(Prompt:="Please enter end date:", Type:=2))

If checkDate(early, EARLIEST, ge) _
And checkDate(late, EARLIEST, ge) _
And checkDate(early, late, le) _
Then
MsgBox "Okay"
' your code here
Else
MsgBox "Not okay"
' more code
End If
Exit Sub
EH:
MsgBox "No date entered"

End Sub