Question

我正在寻找测试日期格式的代码，日期应该采用其中一种格式年：13xx - 20xx 月：xx，x 日：xx，x 洞日期将在下面 2012年1月1日 2012/01/01 2012年1月1日 2012年1月1日

我尝试了以下

    Option Explicit
Sub ttt()
MsgBox (testDate("2012/01/01"))

End Sub

Function testDate(strDateToBeTested As String) As Boolean
Dim regularExpression, match
Set regularExpression = CreateObject("vbscript.regexp")
testDate = False
'regularExpression.Pattern = "(14|13|19|20)[0-9]{2}[- /.]([0-9]{1,2})[- /.]([0-9]{1,2})"
'regularExpression.Pattern = "(\d\d\d\d)/(\d|\d\d)/(\d|/dd)"
regularExpression.Pattern = "([0-9]{4}[ /](0[1-9]|[12][0-9]|3[01])[ /](0[1-9]|1[012]))"
regularExpression.Global = True
regularExpression.MultiLine = True

If regularExpression.Test(strDateToBeTested) Then

'    For Each match In regularExpression.Execute(strDateToBeTested)
      If Len(strDateToBeTested) < 10 Then
        testDate = True
'        Exit For
      End If
'End If
End If
Set regularExpression = Nothing
End Function

Answer 1

我越来越多地想到这个（以及一些研究），我越觉得正则表达式不是这种格式问题的最佳解决方案。结合其他几个想法（ReplaceAndSplit函数归属于所有者），这就是我想出来的。

Option Explicit

Sub ttt()
    Dim dateStr() As String
    Dim i  As Integer
    dateStr = Split("2012/1/1,2012/01/01,2012/1/01,2012/01/1,1435/2/2," & _
                    "1435/02/02,1900/07/07,1435/02/02222222,2015/Jan/03", ",")
    For i = 1 To UBound(dateStr)
        Debug.Print "trying '" & dateStr(i) & "' ... " & testDate(dateStr(i))
    Next i
End Sub

Function testDate(strDateToBeTested As String) As Boolean
    Dim dateParts() As String
    Dim y, m, d As Long
    dateParts = ReplaceAndSplit(strDateToBeTested, "/.-")
    testDate = False
    If IsNumeric(dateParts(0)) Then
        y = Int(dateParts(0))
    Else
        Exit Function
    End If
    If IsNumeric(dateParts(1)) Then
        m = Int(dateParts(1))
    Else
        Exit Function
    End If
    If IsNumeric(dateParts(2)) Then
        d = Int(dateParts(2))
    Else
        Exit Function
    End If
    If (y >= 1435) And (y < 2020) Then  'change or remove the upper limit as needed
        If (m >= 1) And (m <= 12) Then
            If (d >= 1) And (d <= 30) Then
                testDate = True
            End If
        End If
    End If
End Function

'=======================================================
'ReplaceAndSplit by alainbryden, optimized by aikimark
'Uses the native REPLACE() function to replace all delimiters with a common
'delimiter, and then splits them based on that.
'=======================================================
Function ReplaceAndSplit(ByRef Text As String, ByRef DelimChars As String) As String()
    Dim DelimLen As Long, Delim As Long
    Dim strTemp As String, Delim1 As String, Arr() As String, ThisDelim As String
    strTemp = Text
    Delim1 = Left$(DelimChars, 1)
    DelimLen = Len(DelimChars)
    For Delim = 2 To DelimLen
        ThisDelim = Mid$(DelimChars, Delim, 1)
        If InStr(strTemp, ThisDelim) <> 0 Then _
            strTemp = Replace(strTemp, ThisDelim, Delim1)
    Next
    ReplaceAndSplit = Split(strTemp, Delim1)
End Function

正则表达式测试日期VBA

1 个答案: