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

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

采取内森的话，并在日期之前对文字进行扩展：

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

VBA日期清理

3 个答案: