正则expression式来testingdateVBA

我正在寻找一个testingdate格式的代码，date应该是以下格式之一：年份：13xx – 20xx月份：xx，xdate：xx，xdate将在2012/1/1 2012之后/ 01/01 2012/1/01 2012/01/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

越来越多的我思考这个（和一些研究），我认为正则expression式不是这种格式问题的最佳解决scheme。 结合一些其他的想法（与归属于所有者的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