且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2023-02-13 17:56:35

根据添加的信息进行编辑

编辑(5/16/2016):我对代码进行了一些更改,如下所示.根据新信息进行的一项更改使您可以将JoinArrayWithSemiColons函数用作标准工作表函数或用作模块中的函数.那么这是什么意思?这意味着(假设要解析的单元格为A1),在单元格B1中,您可以编写类似于=JoinArrayWithSemiColons(A1)的函数,就像编写普通的工作表函数一样.但是,如果您仍想使用VBA在一定范围的单元格上执行操作,则可以运行TestFunction()之类的过程,如以下代码所示.还要注意,ExtractDateTimeUsers函数不一定必须直接由用户调用,因为现在它已被专门用作JoinArray...函数的帮助函数.

Edited based on added information

Edit (5/16/2016): I made some changes to the code, as you'll find below. One change, based on the new information, allows you to use the JoinArrayWithSemiColons function as either a standard worksheet function, or as function to be used in a module. So, what does this mean? It means that (assuming your cell to parse is A1), in cell B1 you can write a function like =JoinArrayWithSemiColons(A1) just like you'd write a normal worksheet function. However, if you'd still like to perform the action over a range of cells using VBA, you can run a procedure like TestFunction() as found in the code posted below. Also note, the ExtractDateTimeUsers function doesn't necessarily ever need to be called directly by the user because it's now being used exclusively as a helper function for the JoinArray... function.

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

Let me know if this helps to clear things up a bit.

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

You can accomplish this using some Regular Expressions. See the code below for an example. In my case, I have a function to return a multidimensional array of results. In my test procedure, I call this function, then assign the results to an EMPTY matrix of cells (in your test case, you will have to determine where to put it). You do NOT have to assign the result to a group of cells, but rather you can do whatever you want with the array.

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