允许日期条目稍后或等于当前日期

时间:2016-04-18 08:52:29

标签: vba excel-vba excel

我工作的工作表中的列,接受日期值。我想做的是仅允许有效用户条目的日期相同或在当前日期之后。所以,在我的意图中,我想出了以下内容:

Dim StageDate As date
If Target.Column = 11 Then 
  StageDate = InputBox("Enter a Valid Date")
  If StageDate <= Date Then Target.value = StageDate
  Else: MsgBox("Please enter a valid date")
  End If 
End If

这不太好用。我可以问你的建议吗?非常感谢!

2 个答案:

答案 0 :(得分:1)

可能有点多了。我总是喜欢测试是否已经输入了正确的日期。 1<date将返回True,因为1是01/01/1900(或者是31/12/1899)

Public Sub Test()

    Dim dateRange As Range

    Set dateRange = ThisWorkbook.Worksheets("Sheet1").Range("A2")

    If IsDate(dateRange) Then
        If dateRange < Date Then
            MsgBox "Invalid date", vbInformation + vbOKOnly
            dateRange = Null
        End If
    Else
        dateRange = Null
    End If

End Sub

    'Check that the value entered is a date.
    'Returns TRUE/FALSE.
    'http://regexlib.com/DisplayPatterns.aspx?cattabindex=4&categoryId=5

    'Description:
    'DD.MM.YY or DD.MM.YYYY separator could be on choice '.' '/' or '-' leap years compatible, 00 is treated as year 2000.
    'Matches
    '   29.2.04 | 29/02-2004 | 3.4.05
    'Non -Matches
    '   29.2.03 | 2902.2004 | 12.31.1975
    'Author: Dany Lauener
    Public Function IsDate(ADate As Range) As Boolean

        Dim RegX As Object
        Set RegX = CreateObject("VBScript.RegExp")

        RegX.Pattern = "^(((0?[1-9]|[12]\d|3[01])[\.\-\/](0?[13578]|1[02])" & _
                       "[\.\-\/]((1[6-9]|[2-9]\d)?\d{2}))|((0?[1-9]|[12]\d|30)" & _
                       "[\.\-\/](0?[13456789]|1[012])[\.\-\/]((1[6-9]|[2-9]\d)?\d{2}))" & _
                       "|((0?[1-9]|1\d|2[0-8])[\.\-\/]0?2[\.\-\/]((1[6-9]|[2-9]\d)?\d{2}))|" & _
                       "(29[\.\-\/]0?2[\.\-\/]((1[6-9]|[2-9]\d)?(0[48]|[2468][048]|[13579][26])|" & _
                       "((16|[2468][048]|[3579][26])00)|00)))$"
        IsDate = RegX.Test(ADate)

    End Function

You could shorten the `IsDate` function to something like:

    Public Function IsDate(ADate As Range) As Boolean

        Dim tmpDate As Date

        On Error Resume Next
            tmpDate = DateValue(ADate)
            IsDate = (Err.Number = 0)
        On Error GoTo 0

    End Function

答案 1 :(得分:0)

您正在寻找的是DateValue();

https://support.office.com/en-us/article/DATEVALUE-function-df8b07d4-7761-4a93-bc33-b7471bbff252

有了这个你可以比较日期:

DateValue(TextBoxStartDate.Text) < DateValue(TextBoxEndDate.Text)