gpt4 book ai didi

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

转载 作者:塔克拉玛干 更新时间:2023-11-03 05:13:39 24 4
gpt4 key购买 nike

我正在尝试验证 VBA 中的文本框,以便用户无法输入不可能最终成为某个时间间隔内的日期的值。有没有办法确定一个字符串是否可以作为某个时间间隔内的日期的前缀?例如,如果用户需要输入介于 1/1/2018 和 12/31/2018 之间的日期,我想通过“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

最佳答案

如果您拒绝 02/2929/02 如果您输入常规范式单元格然后使用 检测该单元格的格式,Excel 可能会为您完成剩下的工作code>=CELL("format",cr)(c列/r适合)。

关于excel - 确定字符串是否是某个范围内的日期前缀的算法,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53771768/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com