vba - 日期清理功能

Question

我的 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

拆分将日期与后续文本分开，这可以正常工作，但是如果在日期之前出现文本，则输出包含文本的第一部分。我只想从字符串中获取日期(如果存在)并显示它，无论它在字符串中的哪个位置。下面是示例结果:E 列是拆分逻辑的输出，F 列是从另一个工作表评估的整个字符串。

上述示例的所需输出: (E 列提取了正确的日期)

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

我还能在我的 中添加什么日期清理 功能进一步细化？提前致谢!

Answer 1

避免使用正则表达式，例如评论中建议的方式通常是一个好主意，但一分钱一磅:

① 使用正则表达式 mm/dd/yyyy

(0[1-9]|1[012])[- \/.](0[1-9]|[12][0-9]|3[01])[- \/.](19|20)[0-9]{2}

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



您需要调整是否可以减少数字或不同的格式。下面给出一些例子。

您可以将以下功能用作:

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

示例测试:

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 使用:

(0[1-9]|[12][0-9]|3[01])[- \/.](0[1-9]|1[012])[- \/.](19|20)[0-9]{2}

③ 在单日或单月(前一天)的情况下更灵活，使用:

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

你明白了。

笔记:

你总是可以使用通用的东西，比如 (\d{1,2}\/){2}\d{2,4} ，然后使用 ISDATE(return value) 验证函数返回字符串。