日期清理功能

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

Split 将日期与后续文本分开，这可以正常工作，但是如果有文本出现在日期之前，则输出包含文本的第一部分。我只想从字符串中获取日期（如果存在）并显示它，而不管它在字符串中的哪个位置。以下是示例结果：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

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

① 使用正则表达式 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（返回值）验证函数返回字符串。