Vba 日期清理功能

我的Excel电子表格中有一个VBA模块，它试图清理日期数据，其中包含各种问题，文本与日期信息结合在一起。以下是我的主要加载函数：

Public lstrow As Long, strDate As Variant, stredate As Variant
Sub importbuild()
lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row

Function DateOnlyLoad(col As String, col2 As String, colcode As String)

Dim i As Long, j As Long, k As Long

j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1

For i = 2 To lstrow

strDate = spacedate(Worksheets("Data").Range(col & i).Value)
stredate = spacedate(Worksheets("Data").Range(col2 & i).Value)

If (Len(strDate) = 0 And (col2 = "NA" Or Len(stredate) = 0)) Or InStr(1, 
UCase(Worksheets("Data").Range(col & i).Value), "EXP") > 0 Then
 GoTo EmptyRange

Else

Worksheets("CI").Range("A" & j & ":C" & j).Value = 
 Worksheets("Data").Range("F" & i & ":H" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
'Worksheets("CI").Range("L" & j).Value = dateclean(strDate)
Worksheets("CI").Range("F" & j).Value = strDate

If col2 <> "NA" Then
    If IsEmpty(stredate) = False Then
        Worksheets("CI").Range("F" & j).Value = datecleanup(stredate)
    End If
End If
j = j + 1

End If

EmptyRange:

Next i

End Function

样本输出：

Function datecleanup(inputdate As Variant) As Variant

If Len(inputdate) = 0 Then
 inputdate = "01/01/1901"
Else
  If Len(inputdate) = 4 Then
    inputdate = "01/01/" & inputdate
  Else
    If InStr(1, inputdate, ".") Then
        inputdate = Replace(inputdate, ".", "/")
    End If

 End If
End If

datecleanup = Split(inputdate, Chr(32))(0)

 Column A   Column B      Column C     Column D    Column E    Column F
  125156    Wills, C     11/8/1960     MMR1         MUMPS       MUMPS TITER 02/26/2008 POSITIVE     
  291264    Balti, L     09/10/1981    MMR1        (blank)      Measles - 11/10/71 Rubella 
  943729    Barnes, B    10/10/1965    MMR1         MUMPS       MUMPS TITER 10/08/2008 POSITIVE

Option Explicit

Public Sub test()
    Debug.Print RemoveChars("Measles - 11/10/1971 Rubella")
End Sub

Public Function RemoveChars(ByVal inputString As String) As String

    Dim regex As Object, tempString As String
    Set regex = CreateObject("VBScript.RegExp")

    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](19|20)[0-9]{2}"
    End With

    If regex.test(inputString) Then
        RemoveChars = regex.Execute(inputString)(0)
    Else
        RemoveChars = inputString
    End If

End Function

拆分将日期与后续文本分开，这样做很好，但是如果有文本出现在日期之前，则输出包含文本的第一部分。我只想从字符串中获取日期（如果存在）并显示它，而不管它在字符串中的位置如何。下面是示例结果：E列是拆分逻辑的输出，F列是从其他工作表计算的整个字符串

上述示例的所需输出：（E列提取了正确的日期）

---

我还可以在我的datecleanup函数中添加什么来进一步完善它？提前谢谢

避免使用正则表达式，如评论中建议的方式通常是一个好主意，但以一便士换一英镑：

① 使用正则表达式mm/dd/yyyy 该模式来自ipr101，并提出了一个很好的正则表达式，用于验证mm/dd/yyyy的实际日期。我已调整为正确转义几个字符

如果可以是更少的数字或不同的格式，则需要进行调整。下面给出一些例子

您可以将以下功能用作：

Worksheets("CI").Range("F" & j).Value = RemoveChars(datecleanup(stredate))

示例测试：

Function datecleanup(inputdate As Variant) As Variant

If Len(inputdate) = 0 Then
 inputdate = "01/01/1901"
Else
  If Len(inputdate) = 4 Then
    inputdate = "01/01/" & inputdate
  Else
    If InStr(1, inputdate, ".") Then
        inputdate = Replace(inputdate, ".", "/")
    End If

 End If
End If

datecleanup = Split(inputdate, Chr(32))(0)

 Column A   Column B      Column C     Column D    Column E    Column F
  125156    Wills, C     11/8/1960     MMR1         MUMPS       MUMPS TITER 02/26/2008 POSITIVE     
  291264    Balti, L     09/10/1981    MMR1        (blank)      Measles - 11/10/71 Rubella 
  943729    Barnes, B    10/10/1965    MMR1         MUMPS       MUMPS TITER 10/08/2008 POSITIVE

Option Explicit

Public Sub test()
    Debug.Print RemoveChars("Measles - 11/10/1971 Rubella")
End Sub

Public Function RemoveChars(ByVal inputString As String) As String

    Dim regex As Object, tempString As String
    Set regex = CreateObject("VBScript.RegExp")

    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](19|20)[0-9]{2}"
    End With

    If regex.test(inputString) Then
        RemoveChars = regex.Execute(inputString)(0)
    Else
        RemoveChars = inputString
    End If

End Function

---

② 对于dd/mm/yyyy使用：

---

③ 如果是一天或一个月（月的前一天），则更灵活地使用：

你明白了

注:

---

您可以始终使用类似于

（\d{1,2}\/）{2}\d{2,4}

，然后使用ISDATE（返回值）验证函数返回字符串。

循环分割的输出，并使用

ISDATE（）查找日期

如果为true，则返回该值。日期是否始终采用/*/格式？@RicardoA日期将采用M/DD/YYYY或MM/DD/YYYY格式，例如2015年7月16日、2015年7月15日、2015年12月5日非常感谢您的建议！因此，在我上面的主要函数（DateOnlyLoad）中，我可以引用

工作表（“CI”）.Range（“F”&j”）.Value=RemoveChars（datecleanup（stredate））

，然后

strDateCleanup

将在

datecleanup

函数的输入中输入？所以我还是应该保持

datecleanup

函数的原样？关于您提供的其他模式（我只需要MM/DD/YYYY和您的第三个模式），我如何将您的第三个模式（

（[1-9][12][0-9][3[01]）[-\/.]（0？[1-9][1[012]）[-\/.][0-9]{2,4}

）合并到

RemoveChars

函数中？对……使用我在回答中显示的函数。合并其他模式…取决于您实际想要什么。。。。我假设您在任何给定的时间都不允许两种模式，而是允许一种或另一种模式，因此只需swop regex.Pattern=“Pattern”TBH..一旦提取了模式，您就可以使用正常的Excel函数检查它是否为有效日期，因此可以使用类似（\d{1,2}\/）{2}\d{2,4}的泛型，然后使用ISDATE（模式匹配）进行验证。我添加了您的函数并在我的宏中运行它，当日期/文本字符串中有有效日期时，我将返回所有日期的“1/1/1901”。这可能是什么原因造成的？

datecleanup

函数中是否有我需要更改的内容？再次感谢。要添加到我的最后一条评论中，它看起来像在datecleanup函数中看到Len（inputdate）=0，因此它输入了硬编码日期1/1/1901。我通过将硬编码日期更改为1902年1月1日来确认这一点，现在我所有的RemoveChars函数单元格都返回1902年1月1日。你认为什么需要改变？

([1-9]|[12][0-9]|3[01])[- \/.](0?[1-9]|1[012])[- \/.][0-9]{2,4}