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

我有一个包含所有历史更新的单元格，每个更新都会显示一个日期/时间戳，然后在注释前显示用户名。我需要提取所有日期/时间/姓名戳记，以合计其发生次数+编辑+我需要从每个戳记中获取名称和日期部分，以便能够在数据透视表中绘制信息图表类似的输出；“2016年3月3日Rachel Boyers；2016年3月2日Rachel Boyers；2016年3月2日James Dorty”

例： “3/3/2016 9:28:36 Rachel Boyers:EEHAW！Terri回答！！！你好Rachel， 我无法使用4232A或12319零件号找到匹配项。3/2/2016 7:39:06 AM Rachel Boyers:根据EM回复将它们发送给Terri-Eng。3/2/2016 7:35:06 AM James Dorty:2/29/16将另一个EM发送给Kim。收到如下自动回复：谢谢您的邮件。Kim12/7/2015 12:26:25 PM Frank De La Tor回复：再次虚拟机-将傅推出，直到假期结束。

根据添加的信息编辑 编辑（2016年5月16日）：我对代码做了一些更改，如下所示。一个基于新信息的更改允许您将带有分号的

JoinArrayWith函数用作标准工作表函数或模块中使用的函数。那么，这意味着什么呢？这意味着（假设要分析的单元格是
A1
），在单元格
B1
中，您可以像编写普通工作表函数一样编写类似
=joinArrayWith分号（A1）
的函数。但是，如果您仍然希望使用VBA在一系列单元格上执行操作，则可以运行类似
TestFunction（）的过程
如下面发布的代码所示。另外请注意，
ExtractDateTimeUsers
函数不一定需要用户直接调用，因为它现在被专门用作
JoinArray…
函数的助手函数

让我知道这是否有助于澄清问题

旧职位
您可以使用一些正则表达式来实现这一点。有关示例，请参见下面的代码。在我的示例中，我有一个函数来返回多维结果数组。在我的测试过程中，我调用此函数，然后将结果分配给空的单元格矩阵（在您的测试用例中，您必须确定将其放置在何处）。您不必将结果分配给一组单元格，而是可以对数组执行任何操作

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

作为简单（非正则表达式）函数，您可以使用如下内容：

Public Function getCounts(str As String) As Variant

  Dim output() As Variant, holder As Variant, i As Long

  ReDim output(0, 0)
  holder = Split(str, " ")

  For i = 0 To UBound(holder) - 2
    If IsDate(holder(i) & " " & holder(i + 1) & " " & holder(i + 2)) Then

      If UBound(output) Then
        ReDim Preserve output(1 To 3, 1 To UBound(output, 2) + 1)
      Else
        ReDim output(1 To 3, 1 To 1)
      End If

      output(1, UBound(output, 2)) = holder(i)
      output(2, UBound(output, 2)) = holder(i + 1) & " " & holder(i + 2)
      i = i + 3

      While Right(holder(i), 1) <> ":" And i < UBound(holder)
        output(3, UBound(output, 2)) = output(3, UBound(output, 2)) & " " & holder(i)
        i = i + 1
      Wend

      output(3, UBound(output, 2)) = Trim(output(3, UBound(output, 2))) & " " & Left(holder(i), Len(holder(i)) - 1)

    End If
  Next

  If Application.Caller.Rows.Count > UBound(output, 2) Then
    i = UBound(output, 2)
    ReDim Preserve output(1 To 3, 1 To Application.Caller.Rows.Count)

    For i = i + 1 To UBound(output, 2)
      output(1, i) = ""
      output(2, i) = ""
      output(3, i) = ""
    Next

  End If

  getCounts = Application.Transpose(output)

End Function

公共函数getCounts（str作为字符串）作为变量
Dim output（）作为变量，保持架作为变量，i作为变量
重拨输出（0，0）
持有人=拆分（str，“”）
对于i=0至uBond（支架）-2
如果IsDate（持有人（i）和持有人（i+1）和持有人（i+2））则
如果UBound（输出），则
ReDim保留输出（1到3，1到UBound（输出，2）+1）
其他的
重拨输出（1到3，1到1）
如果结束
输出（1，UBound（输出，2））=保持器（i）
输出（2，UBound（输出，2））=保持器（i+1）和“&保持器（i+2）
i=i+3
而权利（持有者（i），1）“：”和iUBound（输出，2），则
i=UBound（输出，2）
ReDim保留输出（1到3，1到Application.Caller.Rows.Count）
对于i=i+1至UBound（输出，2）
输出（1，i）=“”
输出（2，i）=“”
输出（3，i）=“”
下一个
如果结束
getCounts=Application.Transpose（输出）
端函数

只需将它放在一个模块中，作为UDF使用即可。（输出一个3列表）

如果你有任何问题，只要问：）
这是另一种方法。可能会慢一点，但简短易读

Public Function DateCount(str As String) As Variant
Dim pos As Integer, endpos As Integer, namepos As Integer
Dim Text As String, Output() As String, counter As Integer
    pos = InStr(pos + 1, str, "/")
    Do While pos > 0
        endpos = InStr(pos + 1, str, "M ")
        Text = Mid(str, pos - 1, endpos - pos + 2)
        If IsDate(Text) Then
            counter = counter + 1
            ReDim Preserve Output(1 To 2, 1 To counter)
            namepos = InStr(endpos, str, ":")
            Output(1, counter) = Text
            Output(2, counter) = Mid(str, endpos + 2, namepos - endpos - 2)
            pos = namepos
        End If
        pos = InStr(pos + 1, str, "/")
    Loop

' Only Count
getCounts = counter
' complete List
getCounts = Output
End Function

看起来像
：
是你的钥匙。连同@findwindow-查看，可能使用
空格作为分隔符。@findwindow我以为是“AM”或“PM”“是钥匙。”啊，是的，这有助于抓住这个名字。编辑：或者你知道的只是regex=Palso有助于抓紧时间…只需计算一下backwards就行了！万一OP想知道（和我一样有一分钟）如何使用它：（1）将上述代码复制到一个模块中（2）假设您要分析的注释位于单元格
A1
中，您应该将其放入
B1
中：
=INDEX（getCounts（$a$1）；ROW（）；COLUMN（）-1）
（3）将公式复制到列
D
，并向下复制到第4行（对于您提供的上述示例）。假设文本为A1，只需选择B1:D10并使用ctrl+shift+enter；输入
=getCounts（A1）
）您好，谢谢您在这方面的帮助，我试图实现这一点（但我在VBA和编程领域是一个完全的新手），我无法得到我希望的结果，并对问题进行了编辑，可能会帮助您帮助我！上面正则表达式的输出应该是什么样子？@AaronBondy现在，
ExtractDateTimeUsers
函数返回一个值数组。如果您不熟悉数组，那么它们本质上是存储在内存中的表。现在，“表”有三列（一列表示日期，一列表示时间，一列表示用户名），每个匹配项有一行。如果需要返回一个由分号分隔的长字符串，可以使用helper函数来实现。我会编辑上面的代码，希望能把它清理干净。我明白了，这太棒了。但是，我有一个问题，我希望使用它，因为我需要获得整个单元格列的这种类型的数据，数据类似于我发布的示例。a1-a（N）都有一个类似示例的字符串，我希望能够以一种格式获得这些信息，通过这种格式我可以跟踪所有日期/姓名戳。有可能吗