Question

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

EX：＆＃34; 3/3/2016 9:28:36 AM Rachel Boyers： EEHAW！特丽回答说!!!你好雷切尔，我找不到使用4232A或12319部件号的匹配。 3/2/2016 7:39:06 AM Rachel Boyers：向EM发送EM - 每个EM回复。 3/2/2016 7:35:06 AM James Dorty： 2/29/16向Kim发送了另一个EM。收到自动回复如下：感谢您的邮件。 Kim 2015年12月7日下午12:26:25 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

Answer 2

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

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列表）

如果您有任何疑问，请询问：）

Answer 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

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

3 个答案:

根据添加的信息进行编辑

旧帖子