vba遍历字符串以查找日期

Question

我正在尝试遍历文件名以查找日期。我没有要查找的特定日期，只是尝试提取一个日期（如果文件名中存在一个日期）。问题是用户不是每次都使用相同的格式，所以我要考虑从 1-1-14 到 01-01-2014 的所有内容。我为此编写了一个函数，但是当文件名中的日期为 06-23-2014 时，我得到的返回值为 201 年 6 月 23 日。示例文件名为“F2 A-Shift 06-23-2014 Daily Sustaining Report.xls”和“F1C-Shift 6-25-14 Daily Sustaining Report.xls”。任何关于可行解决方案的帮助将不胜感激。

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

Answer 1

您的第一个问题是您假设日期始终为 10 个字符，第二个问题是您正在检查有效日期，一旦获得有效日期，您就存在循环。

您使用的代码永远不会将 6-1-14 识别为有效日期，因为即使有尾随和前导空格，当您查看 10 个字符的块时，它也永远不会是有效日期。

第二个问题的问题在于If IsDate(Mid(strName, i, 10)) = True Then

Excel 在许多方面做得很好，其中之一就是猜测您要做什么。您假设日期上的前导空格（例如“ 06-23-201”）不会被视为有效日期，但您不正确。 IsDate 函数将此视为有效日期，因此您的循环在您到达“4”之前就退出了。这就是为什么您只会收到6/23/201。

所以要解决你的两个问题，你需要修改你的逻辑。与其专注于一次检查 10 个字符，不如利用日期似乎总是有前导或尾随空格这一事实。

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

Answer 2

您在函数中看到结果的原因是 IsDate 函数忽略了前导空格。所以“1/1/01”将被视为一个日期。为了使您的功能正常工作，您可能需要检查一下；也许通过确保第一个和最后一个字符是数字；确定长度；并确保日期前后有空格。

另一种方法是使用正则表达式来解析所有内容。在不检查无效日期（例如 2 月 31 日）的情况下，以下是一种方法：

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

Answer 3

有用的输入谢谢！

我已经对其进行了调整以适应我的需要，结果如下：

Sub DateGet()

Dim datDate                         As Date
Dim intDay                          As Integer
Dim intMth                          As Integer
Dim intYr                           As Integer
Dim i                               As Integer
Dim strSeparator                    As String

datDate = DateStrip(Selection.Value)

For i = 1 To Len(datDate)
    If Not IsNumeric(Mid(datDate, i, 1)) Then
        strSeparator = Mid(datDate, i, 1)
        Exit For
    End If
Next
intDay = Mid(datDate, 1, i - 1)
intMth = Mid(datDate, i + 1, InStr(i + 1, datDate, strSeparator) - i - 1)
intYr = Mid(datDate, InStr(i + 1, datDate, strSeparator) + 1, 4)
'Debug.Print intDay & strSeparator & intMth & strSeparator & intYr

结束子

函数 DateStrip(strName As String) As Date 将 intLen 调暗为整数 将 i 调暗为整数 将 S 调暗为字符串

intLen = Len(strName)
If intLen <= 10 Then Exit Function
For i = 1 To intLen
    If Mid(strName, i, 1) Like "#" Then
        S = Mid(strName, i, InStr(i + 1, strName, " ") - i)
        If IsDate(S) Then
            DateStrip = S
            Exit Function
        End If
    End If
Next i

结束函数

Answer 4

您始终可以创建自己的 RegEx 函数来简化：

Function RegEx(Target As String, RegExpression As String, _
               Optional ReplaceString As String, Optional xIgnoreCase As Boolean, _
               Optional xGlobal As Boolean, Optional xMultiLine As Boolean)

    Dim regexOne As Object
            
    Set regexOne = New RegExp
    regexOne.Pattern = RegExpression
    If xIgnoreCase Then regexOne.IgnoreCase = xIgnoreCase
    If xGlobal Then regexOne.Global = xGlobal
    If xMultiLine Then regexOne.MultiLine = xMultiLine
    
    If regexOne.Test(Target) Then
        If IsMissing(ReplaceString) Then
            RegEx = regexOne.Execute(Target)
        Else
            RegEx = regexOne.Replace(Target, ReplaceString)
        End If
    End If
        
End Function

Answer 5

你可以使用

Function DateValueFn(Str as String) as Date
    On Error Goto ERRORHANDLER
    DateValueFn = DateValue(Str)
    Exit Function
ERRORHANDLER:
    DateValueFn = 0
End Function

现在如果用户给出一个无效的输出，这个函数返回 0，否则返回日期。你可以检查它被调用的地方并使用它。

现在，由于文件名存储为SomestringDateString，其中两个子字符串的长度都是可变的，因此用户需要运行一个循环来检查所有子字符串，以便（以下代码存在于 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，则上述循环需要成为双循环，Right 被Mid 函数替换，因此字符串的所有可能子集，从字符 1:6 到字符N-5:N再1:7到N-6:N等都需要检查。