vba通过string查找date
我试图通过文件名来find一个date。 我没有一个特定的date，我正在寻找，只是试图拉一个date，如果一个存在于文件名。 问题是，用户不会每次都使用相同的格式，所以我从1-1-14到01-01-2014都有所考虑。 我为此写了一个函数，但是当文件名中的date是06-23-2014时，我得到了6/23/201的返回值。 示例文件名是“F2 A-Shift 06-23-2014 Daily Sustaining Report.xls”和“F1C-Shift 6-25-14 Daily Sustaining Report.xls”。 任何可行的解决scheme的帮助将不胜感激。
Function GetDate(strName As String) As Date Dim intLen As Integer, i As Integer intLen = Len(strName) If intLen <= 10 Then Exit Function For i = 1 To intLen - 10 If IsDate(Mid(strName, i, 10)) = True Then GetDate = (Mid(strName, i, 10)) Exit Function End If Next i GetDate = "1/1/2001" End Function 你的第一个问题是你假设一个date总是10个字符，第二个是你正在检查一个有效的date，只要你有一个有效的date，你现有的循环。
您正在使用的代码将永远不会将6-1-14识别为有效的date，因为即使具有尾随和前导空格，当您查看10个字符的块时，它也永远不会成为有效的date。
你的第二个问题的问题在于If IsDate(Mid(strName, i, 10)) = True Then
有很多东西Excel做得太好，其中之一是猜测你正在做什么。 您假定某个date（例如“06-23-201”）的前导空间不被视为有效date，但是您不正确。 IsDate函数认为这是一个有效的date，所以你的循环退出之前，你甚至到“4”。 这就是为什么你只得到6/23/201 。
所以为了解决你的两个问题，你需要修改你的逻辑。 而不是一次检查10个字符，你应该使用这样的事实，即你的date似乎总是有一个前导或尾随的空间。
Function GetDate(strName As String) As Date Dim FileNameParts as Variant Dim part as Variant FileNameParts = Split(strName," ") For Each part in FileNameParts If IsDate(part ) = True Then GetDate = part Exit Function End If Next GetDate = "1/1/2001" End Function
你在你的函数中看到的结果是因为IsDate函数忽略了前导空格。 所以“1/1/01”将被视为一个date。 为了使你的function起作用，你可能需要检查一下; 也许通过确保第一个和最后一个字符是数字; 确定长度; 并确保date周围有空间。
另一种方法是使用正则expression式来parsing所有这些。 没有检查无效date（例如fb31），以下是一种方法：
Option Explicit Function GetDate(S As String) As Date Dim RE As Object, MC As Object Set RE = CreateObject("vbscript.regexp") With RE .Pattern = "\b(0?[1-9]|1[012])[- /.](0?[1-9]|[12][0-9]|3[01])[- /.](19|20)?[0-9]{2}\b" If .test(S) = True Then Set MC = .Execute(S) GetDate = MC(0) Else GetDate = "1/1/2001" End If End With End Function
稍加努力，我已经稍微修改了原来的方法，我相信也应该这样做：
Function GetDate(strName As String) As Date Dim intLen As Integer, i As Integer Dim S As String intLen = Len(strName) If intLen <= 10 Then Exit Function For i = 1 To intLen - 10 If Mid(strName, i, 1) Like "#" Then S = Mid(strName, i, InStr(i, strName, " ") - 1) If IsDate(S) Then GetDate = S Exit Function End If End If Next i GetDate = "1/1/2001" End Function
您可以使用
Function DateValueFn(Str as String) as Date On Error Goto ERRORHANDLER DateValueFn = DateValue(Str) Exit Function ERRORHANDLER: DateValueFn = 0 End Function
现在，如果用户输出无效，则该函数返回0，否则返回date。 你可以在任何被调用的地方进行检查并使用它。
现在，由于文件名存储为SomestringDateString ，其中两个子string都是可变长度的，所以用户将需要运行一个循环来检查所有的子string，以便（以下代码存在于for循环中）
SubStr = Right(FileName, i) 'i loops from 6 to 16 or till length of FileName DtVal = DateValueFn(SubStr) If DtVal !=0 ' Date Found, do something, raise a flag perhaps and inspect DtVal Exit For Else ' Date Not Found, continue looking, maybe raise a flag if no date found for all i End if
最后，如果文件名的格式为Somestring1DateStringSomestring2则上面的循环需要成为一个Double操作符， Right被Mid函数取代，因此所有可能的string子集，从字符1：6到字符N-5：N，然后是1： 7到N-6：N等需要检查。