Excel vba通过字符串循环查找日期

我试图通过文件名循环查找日期。我没有一个具体的日期，我正在寻找，只是试图拉一个日期，如果一个存在于文件名。问题是，用户每次都不使用相同的格式，所以我从1-1-14到01-01-2014都要考虑。我为此编写了一个函数，但当文件名中的日期为06-23-2014时，我得到的返回值为6/23/201。示例文件名为“F2 A-Shift 06-23-2014每日维持报告.xls”和“F1C Shift 6-25-14每日维持报告.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

函数GetDate（strName作为字符串）作为日期 Dim intLen为整数，i为整数 intLen=Len（strName） 如果intLen您可以使用

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

现在，如果用户提供的输出无效，则此函数返回0，否则返回日期。无论它在哪里被调用，您都可以进行检查并使用它

现在，由于文件名存储为

SomestringDateString

，其中两个子字符串的长度都是可变的，因此用户需要运行一个循环来检查所有子字符串，以便（for循环中存在以下代码）

---

---

最后，如果文件名的格式为

Somestring1DateStringSomestring2

，则上述循环需要变成一个双doop，用

Right

替换为

Mid

函数，以便字符串的所有可能子集，从字符1:6到字符N-5:N，然后是1:7到N-6:N，等等。需要检查。

在函数中看到结果的原因是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

函数GetDate（strName作为字符串）作为日期 Dim intLen为整数，i为整数 像线一样变暗 intLen=Len（strName）

---

如果intLen你的第一个问题是你假设一个日期总是10个字符，第二个问题是你正在检查一个有效的日期，一旦你得到一个有效的日期，你就存在你的循环

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

第二个问题的问题在于

如果IsDate（Mid（strName，i，10））=True，则

有很多事情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

有用的输入谢谢

我调整了它以满足我的需要，结果如下：

子日期获取（）

端接头

函数DateStrip（strName作为字符串）作为日期
作为整数的Dim intLen
作为整数的Dim i
像线一样变暗

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

intLen=Len（strName）
如果intLen您始终可以创建自己的正则表达式函数来简化：

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

日期在>之前和之后是否总是有空格？是否确实需要以文件名中存在的格式返回日期？是否需要将其用作工作表公式？嗯。。。。这只适用于OP的情况，即当整个文件名是日期时，否则您只能得到0。我假设OP应该能够使用它将字符串的子集解析为日期，例如，从大小6（1/2/03）到16（1994年12月8日）的字符串中提取子部分取决于命名中使用的日期的业务逻辑。启发式将取决于日期通常如何写入用户文件夹，但就解析而言，我认为这将是一个有效的工具。如果答案不适合该问题，我猜我可以删除它。问题是它并不真正相关。是的，它有助于解析日期，但鉴于OP将日期作为返回值没有问题，我认为这不会解决他的问题。编辑：使用一些示例代码详细说明，可以运行解析器从filenamebeautiful解决方案中提取日期。：）然后，可以在我下面的答案中使用日期解析器来验证DateStrings的有效性，这可能是最好的答案，只要日期是以空格分隔的（或者至少是以已知的分隔符分隔）。我查看了2年的文件名，发现日期总是以空格分隔，这是一个很好的选择。测试没有发现任何问题。感谢您的指导。@HansRFranz如果您找到其他可能的分隔符（如破折号或其他类似字符），则可以使用一些工作区来处理多个分隔符，如，但日期中出现破折号可能会使此操作更加困难。
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

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