从单个细胞中提取多个date
我有一个包含所有历史更新的单元，每个更新显示一个date/时间戳，然后显示用户的名字，然后显示他们的笔记。 我需要提取所有的date/时间/名称邮票总数的发生。 +编辑+我需要从每张邮票获得名称和date部分，以便我能够在数据透视表中绘制信息。 输出类似的东西; “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：00 Rachel Boyers：发送EM到Terri – Eng每EM的回复。2016 /2/ 3 7:35:06 James Dorty： 2/29/16发送另一个EM给Kim。收到自动响应如下：谢谢你的Kim 12/7/2015 12:26:25 PM Frank De La Torre：又是VM–把FU推到假期之后。
根据添加的信息进行编辑
编辑（5/16/2016）：我对代码进行了一些更改，如下所示。 一个基于新信息的更改允许您使用JoinArrayWithSemiColons函数作为标准工作表函数，或作为在模块中使用的函数。 那么这是什么意思？ 这意味着（假设您的单元格parsing为A1 ），在单元格B1您可以编写一个函数，如=JoinArrayWithSemiColons(A1) ，就像编写普通的工作表函数一样。 但是，如果您仍想使用VBA在一系列单元格上执行操作，则可以运行像下面所示代码中所示的TestFunction()这样的过程。 另请注意， ExtractDateTimeUsers函数不一定需要由用户直接调用，因为它现在被专门用作JoinArray...函数的辅助函数。
让我知道这是否有助于清理一些事情。
旧邮政
您可以使用一些正则expression式来完成此操作。 有关示例，请参阅下面的代码。 在我的情况下，我有一个函数返回一个多维的结果数组。 在我的testing过程中，我调用这个函数，然后把结果赋给一个EMPTY的单元matrix（在你的testing案例中，你将不得不决定把它放在哪里）。 您不必将结果分配给一组单元格，而是可以对数组执行任何操作。
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
作为简单的（非正则expression式）函数，你可以使用这样的东西：
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
只要把它放在一个模块中，就可以将它用作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