从单个单元格中提取多个日期

Question

我有一个包含所有历史更新的单个单元格,每个更新都显示一个日期/时间戳,然后是用户的注释之前的名称.我需要提取所有日期/时间/名称标记以总计它们的出现次数.+编辑+我需要从每个邮票中获取名称和日期部分,以便我能够在数据透视表中绘制信息.输出类似的东西; "2016/3/3 Rachel Boyers; 3/2/2016 Rachel Boyers; 3/2/2016 James Dorty"

EX:" 2016年3月3日上午9:28:36 Rachel Boyers: EEHAW!Terri回复!!!你好Rachel,我找不到使用4232A或12319部件号的比赛.3/2/ 2016 7:39: 06 AM Rachel Boyers: 发送EM到Terri - Eng每EM回复.3/2/2016 7:35:06 AM Dorty: 2/29/16向Kim发送另一个EM.收到如下自动回复:谢谢你的支持邮件.Kim 12/7/2015 12:26:25 PM Frank De La Torre: 再次VM - 将FU推到假期之后.

Answer 1

根据添加的信息进行编辑

编辑(2016年5月16日):我对代码进行了一些更改,如下所示.基于新信息的一项更改允许您将该JoinArrayWithSemiColons函数用作标准工作表函数或用作模块中的函数.那么这是什么意思？这意味着(假设您的单元要解析A1),在单元格中,B1您可以编写一个函数=JoinArrayWithSemiColons(A1),就像您编写正常的工作表函数一样.但是,如果您仍希望使用VBA对一系列单元格执行操作,则可以运行类似TestFunction()下面发布的代码中的过程.另请注意,该ExtractDateTimeUsers函数不一定需要由用户直接调用,因为它现在仅用作函数的辅助JoinArray...函数.

让我知道这是否有助于澄清一些事情.

老邮政

您可以使用一些正则表达式完成此操作.有关示例,请参阅下面的代码.在我的例子中,我有一个函数来返回一个多维数组的结果.在我的测试过程中,我调用此函数,然后将结果分配给EMPTY单元格矩阵(在测试用例中,您将必须确定将其放在何处).您不必将结果分配给一组单元格,而是可以使用数组执行任何操作.

Private Function ExtractDateTimeUsers(nInput As String) As Variant()
    Dim oReg As Object
    Dim aOutput() As Variant
    Dim nMatchCount As Integer
    Dim i As Integer
    Dim vMatches As Object

    Set oReg = CreateObject("VBScript.RegExp")

    With oReg
        .MultiLine = False
        .Global = True
        .Pattern = "([0-9]{1,2}/[0-9]{1,2}/[0-9]{2,4}) ([0-9]{1,2}:[0-9]{1,2}:[0-9]{1,2} [AP]M) (.*?):"
    End With

    If oReg.Test(nInput) Then
        Set vMatches = oReg.Execute(nInput)
        nMatchCount = vMatches.Count
        ReDim aOutput(0 To nMatchCount - 1, 0 To 2)

        For i = 0 To nMatchCount - 1
            aOutput(i, 0) = vMatches(i).Submatches(0)
            aOutput(i, 1) = vMatches(i).Submatches(1)
            aOutput(i, 2) = vMatches(i).Submatches(2)
        Next i
    Else
        ReDim aOutput(0 To 0, 0 To 0)
        aOutput(0, 0) = "No Matches"
    End If


    ExtractDateTimeUsers = aOutput
End Function

Function JoinArrayWithSemiColons(sInput As String) As String
    Dim vArr As Variant

    vArr = ExtractDateTimeUsers(sInput)

    If vArr(0, 0) = "No Matches" Then
        JoinArrayWithSemiColons = "No Matches"
        Exit Function
    End If

    'Loop through array to build the output string
    For i = LBound(vArr, 1) To UBound(vArr, 1)
        sOutput = sOutput & "; " & vArr(i, 0) & " " & vArr(i, 2)
    Next i

    JoinArrayWithSemiColons = Mid(sOutput, 3)
End Function

Sub TestFunction()
    'Assume the string we are parsing is in Column A
    '(I defined a fixed range, but you can make it dynamic as you need)

    Dim rngToJoin As Range
    Dim rIterator As Range

    Set rngToJoin = Range("A10:A11")

    For Each rIterator In rngToJoin
        rIterator.Offset(, 1).Value = JoinArrayWithSemiColons(rIterator.Value)
    Next rIterator

End Sub