日期清理功能

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

datecleanup函数：

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

我还可以在 datecleanup 函数中添加哪些内容以进一步优化此功能？提前谢谢！

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（返回值）验证函数返回字符串。