VBA 日期清理

Question

我有一些日期数据要清理并删除日期中的所有文本。

我有以下将数据输出到工作表的代码，它有一个单独的 datecleanup 函数，如果缺少日期或只有 4 位数字，它会执行一些日期清理，但是我仍然在输出数据包含日期和文本的混合（以下示例）。

主要功能：

Function TetanusLoad(col As String, col2 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

If Len(Worksheets("Data").Range(col & i).Value) = 0 And 
Len(Worksheets("Data").Range(col2 & i).Value) = 0 Then
GoTo EmptyRange
Else
  strDate = spacedate(Worksheets("Data").Range(col & i).Value)
  Worksheets("CI").Range("A" & j & ":C" & j).Value = 
   Worksheets("Data").Range("F" & i & ":H" & i).Value

Select Case Worksheets("Data").Range(col2 & i).Value
    Case "Tdap"
        Worksheets("CI").Range("D" & j).Value = "TDA"
    Case "Td"
        Worksheets("CI").Range("D" & j).Value = "TD"
    Case Else
        Worksheets("CI").Range("D" & j).Value = "REVIEW"
End Select

Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)

 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 = inputdate

End Function

我正在尝试纠正的 E 列的示例数据输出示例：

07/06/1993 - HAD ALLERGIC REACTION ; ARM SWELLED AND GOT RED AND HOT
09/23/2004 - REPORTS REACTION TO TETANUS SHOT
12/03/2015 Rubelo reported

我不希望包含额外的文本，因为这应该是一个仅限日期的字段。我怎样才能做到这一点？理想情况下，我希望它在 datecleanup 函数中被引用，因为其他函数也使用它。

Answer 1

如果是日期之前的文本，则采用 Nathan 并对其进行扩展：

Function dateclean(strInput As String) As String
    Dim strSplits As Variant, i As Integer, dateFound As String
    strSplits = Split(strInput, Chr(32))
    For i = 0 To UBound(strSplits)
        If strSplits(i) Like "*/*/*" Then
            dateFound = strSplits(i)
            Exit For
        End If
    Next i
    dateclean = dateFound
End Function

Answer 2

类似的东西

function dateclean(strInput as string) as string
     dateclean=split(strInput,chr(32))(0)
end function

Answer 3

不确定您的所有代码是做什么的 - 它没有说明 lstRow 的定义位置。

此示例在Data!D2:D4 范围内包含您的示例。
输出将出现在CI!D2:D4 范围内。

注意 - 我已经更新了一些变量名（尽管它们没有被使用）。
例如。 CI_LastRow 包含的内容更明显，而不是弄清楚 j 代表什么。

Sub Test()

    TetanusLoad 4, 5

End Sub

Public Sub TetanusLoad(col As Long, col2 As Long)

    Dim CI_LastRow As Long, Error_LastRow As Long
    Dim Data_Range As Range, rCell As Range

    CI_LastRow = Worksheets("CI").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Error_LastRow = Worksheets("Error").Cells(Rows.Count, 1).End(xlUp).Row + 1

    'This is the range containing your date/text strings.
    With Worksheets("Data")
        Set Data_Range = .Range(.Cells(1, col), .Cells(.Rows.Count, col).End(xlUp))
    End With

    For Each rCell In Data_Range
        Worksheets("CI").Cells(rCell.Row, 5) = datecleanup(rCell)
    Next rCell

End Sub

Function datecleanup(inputdate As Variant) As Variant
    Dim re, match
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
    re.Global = True

    For Each match In re.Execute(inputdate)
        If IsDate(match.Value) Then
            datecleanup = CDate(match.Value)
            Exit For
        End If
    Next
    Set re = Nothing

End Function  

datecleanup 函数是此链接上的 FormatOutput 函数的副本：
VBA Regular Expression to Match Date