Question

我正在尝试验证VBA中的文本框，以使用户无法输入在某个时间间隔内不可能最终成为日期的值。是否有一个很好的方法来确定字符串是否可以作为某个时间间隔的日期的前缀？例如，如果用户需要输入2018年1月1日至2018年12月31日之间的日期，我希望传递“ 02/20”，但不希望输入“ 02/29”。日期可以采用mm / dd / yyyy或dd / mm / yyyy格式，尽管我只对其中一种格式采用了很好的算法。我不确定没有很多循环或条件的方式来做到这一点。

编辑：如果有人要检查它，我想我找到了一个不错的解决方案。

Private Sub mMainControl_Change()

    Dim vIsValid As Boolean
    Dim vPrefixLength As Integer
    Dim vDatePrefix As String

    vDatePrefix = CStr(mMainControl.Value)
    vPrefixLength = Len(vDatePrefix)

    If vPrefixLength = 0 Then
        Exit Sub
    ElseIf Not InitialCheck(vDatePrefix, mMinValue, mMaxValue) Then
        vIsValid = False
    ElseIf mMaxValue - mMinValue > 365 Then
        If Not FullYearCheck(vDatePrefix, mMinValue, mMaxValue) Then vIsValid = False
    Else
        If Not PartYearCheck(vDatePrefix, mMinValue, mMaxValue) Then vIsValid = False
    End If

    If Not vIsValid Then mMainControl.Value = Left(vDatePrefix, Min(10, vPrefixLength - 1))

End Sub

Private Function InitialCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean

    Dim vPrefixLength As Integer
    Dim vTestDate As Variant

    vPrefixLength = Len(DatePrefix)

    If vPrefixLength > 10 Or Not DatePrefix Like Left("##/##/####", vPrefixLength) Then
        InitialCheck = False
        Exit Function
    End If

    On Error Resume Next
    vTestDate = CDate(DatePrefix & Right("01/01/1996", 10 - vPrefixLength))
    vTestDate = CDate(DatePrefix & Right("01/00/1984", 10 - vPrefixLength))
    On Error GoTo 0

    InitialCheck = Not IsEmpty(vTestDate)

End Function

Private Function FullYearCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean

    Dim i As Integer, vPrefixLength As Integer, vMinPrefixYear As Integer, vMaxPrefixYear As Integer
    Dim vFullDate As Variant

    vPrefixLength = Len(DatePrefix)
    If vPrefixLength > 6 Then
        vMinPrefixYear = CInt(Right(DatePrefix, vPrefixLength - 6) & Left("0000", 10 - vPrefixLength))
        vMaxPrefixYear = CInt(Right(DatePrefix, vPrefixLength - 6) & Left("9999", 10 - vPrefixLength))
        If Year(MinDate) < vMinPrefixYear Then MinDate = DateSerial(vMinPrefixYear, 1, 1)
        If Year(MaxDate) > vMaxPrefixYear Then MaxDate = DateSerial(vMaxPrefixYear, 12, 31)
    End If

    For i = 0 To Year(MaxDate) - Year(MinDate)
        vFullDate = DatePrefix & Right("01/01/" & CStr(Year(MinDate) + i), 10 - vPrefixLength)
        If ValidByMonth(vFullDate, MinDate, MaxDate) Or ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For
        vFullDate = DatePrefix & Right("01/00/" & CStr(Year(MinDate) + i), 10 - vPrefixLength)
        If ValidByMonth(vFullDate, MinDate, MaxDate) Or ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For Else vFullDate = Empty
    Next i

    FullYearCheck = Not IsEmpty(vFullDate)

End Function

Private Function PartYearCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean

    Dim i As Integer, vPrefixLength As Integer
    Dim vFullDate As Variant

    vPrefixLength = Len(DatePrefix)

    For i = 0 To MaxDate - MinDate
        vFullDate = DatePrefix & Right(Format(CStr(MinDate + i), "mm/dd/yyyy"), 10 - vPrefixLength)
        If ValidByMonth(vFullDate, MinDate, MaxDate) Then Exit For
        vFullDate = DatePrefix & Right(Format(CStr(MinDate + i), "dd/mm/yyyy"), 10 - vPrefixLength)
        If ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For Else vFullDate = Empty
    Next i

    PartYearCheck = Not IsEmpty(vFullDate)

End Function

Private Function ValidByMonth(ByVal DateString As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean

    Dim vTestDate As Variant

    On Error Resume Next
    vTestDate = CDate(MonthName(Left(DateString, 2)) & " " & Mid(DateString, 4, 2) & ", " & Right(DateString, 4))
    If vTestDate < MinDate Or vTestDate > MaxDate Then vTestDate = Empty
    On Error GoTo 0

    ValidByMonth = Not IsEmpty(vTestDate)

End Function

Private Function ValidByDay(ByVal DateString As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean

    Dim vTestDate As Variant

    On Error Resume Next
    vTestDate = CDate(MonthName(Mid(DateString, 4, 2)) & " " & Left(DateString, 2) & ", " & Right(DateString, 4))
    If vTestDate < MinDate Or vTestDate > MaxDate Then vTestDate = Empty
    On Error GoTo 0

    ValidByDay = Not IsEmpty(vTestDate)

End Function

Answer 1

如果您拒绝02/29和29/02，那么，如果您输入“常规”格式的单元格，然后使用=CELL("format",cr)检测该单元格的格式，则Excel可能会为您完成其余工作（ c < / strong> olumn / r 适合）。

确定字符串是否是某个范围的日期前缀的算法

1 个答案: