查找在连续数据中花费的时间

Question

我正在寻找在数据集中花费的总时间

我的数据集可能如下所示： （第一次建议后更新数据集）

Starting time	Ending time
44224,32869	44224,33603
44224,30975	44224,33616
44224,30965	44224,32824
44223,34859	44223,46875
44223,41349	44223,44875

这将给我 9000 - 4000,50 - 500 的总时间（从没有时间在 5000 到 5500 之间工作）= 4499,5

找到最小开始时间和最大结束时间给了我这个集合的范围，如果下一个开始时间大于上一个结束时间，我可以从中减去数据（例如在5000到6000，减去1000） .但是，从最后一个数据点可以看出，这 1000 个减去的时间单位中的 500 个在总时间中已被使用。有没有什么简单的方法可以从这样的数据集中找到总花费的时间？在 VBA Excel 中编程。感谢您的宝贵时间！

目前正在使用此代码：

    For i = 7 to lastRow

            If timeEnd(i) < timeStart(i - 1) Then

                subtractTime = subtractTime + (timeStart(i - 1) - timeEnd(i))

            End If
            
            If timeStart(i) < firstTime Then

                firstTime = timeStart(i)
                
            End If
            
            
            If timeEnd(i) > lastTime Then
                
                lastTime = timeEnd(i)
                
            End If

            totalTimeSpent(i) = lastTime - firstTime - subtractTime

    Next i

    

找到适用于我的数据集的解决方案：首先对数据进行排序，使其按顺序排列，然后运行上面的代码。

Answer 1

这是很长的路要走，它将时间从最低到最高循环并计数：

    Function mytime(stRng As Range, edRng As Range)
        Dim stArr() As Variant
        stArr = Intersect(stRng.Parent.UsedRange, stRng).Value
        
        Dim edArr() As Variant
        edArr = Intersect(edRng.Parent.UsedRange, edRng).Value
        If UBound(stArr, 1) <> UBound(edArr, 1) Then Exit Function
        
        Dim cnt As Long
        cnt = 0
        
        For i = Application.Min(stArr) To Application.Max(edArr)
            For j = 1 To UBound(stArr, 1)
                If i >= stArr(j, 1) And i < edArr(j, 1) Then
                    cnt = cnt + 1
                    Exit For
                End If
            Next j
        Next i
        
        mytime = cnt
        
    End Function

Answer 2

这是一个 Power Query 解决方案（在 Windows Excel 2010+ 和 Office 365 中可用）

它列出了列表中所有唯一条目的列表，这些条目跨越了所花费的时间；并返回计数。

有关详细信息，请参阅 M 代码和注释。也可以通过Applied Steps

M 码

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Starting time", Int64.Type}, {"Ending time", Int64.Type}}),

    //add a list of the times. Since we want duration, exclude the last time in the end time.
    #"Added Custom" = Table.AddColumn(#"Changed Type", "timeList", each {[Starting time]..[Ending time]-1}),

    //remove duplicates and count the remainder
    uniqueTimes = List.Count(
                    List.Distinct(
                        List.Combine(#"Added Custom"[timeList]))),

    //convert to a table for display
    #"Converted to Table" = #table({"Time Spent"}, {{uniqueTimes}})
in
    #"Converted to Table"

这是一个使用相同算法的 VBA UDF（用户定义函数）：

Option Explicit
Function timeSpent(starts As Range, ends As Range) As Long
    Dim vStart, vEnd
    Dim I As Long, J As Long
    Dim colTimes As Collection
    
'Transfer ranges to vba arrays for faster processing
vStart = starts
vEnd = ends

'Sanity Check
If UBound(vStart) <> UBound(vEnd) Then
    MsgBox "Start and End time ranges must be the same size"
    Exit Function
End If

'create unique list of times

Set colTimes = New Collection

'A collection object will return an error if you try to add an item with a duplicate key
On Error Resume Next
For I = 1 To UBound(vStart, 1)
    For J = vStart(I, 1) To vEnd(I, 1) - 1
        colTimes.Add Item:=J, Key:=CStr(J)
    Next J
Next I
On Error GoTo 0
        
timeSpent = colTimes.Count

End Function

Answer 3

gap and island 解决方案实际上是一段非常短的代码——大部分是输出。我正在使用 Nigel Heffernan 发布的quicksort

Option Base 1
Option Explicit


Sub GapAndIsland()

    Dim varData As Variant
    Dim minStart As Variant
    Dim maxEnd As Variant
    Dim i As Long
    Dim gap As Variant
    


    ' Set the array

    varData = Range("f2:g6").Value

    ' *** Modified code to remove bad data ***
    
    ' Remove elements that are not number or date

    Call RemoveInvalid(varData, lastUsed)

    ' Sort https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba

    Call QuickSortArray(varData, 1, lastUsed, 1)

    ' *** end of modified code ***

    ' Initialise
      
    minStart = varData(1, 1)
    maxEnd = varData(1, 1)
    gap = 0
    
    ' Loop over rows
    ' *** This line also modified ***

    For i = 1 To lastUsed
    
    ' If there is a gap, increment total gap length
    
        If (varData(i, 1)) > maxEnd Then
            gap = gap + varData(i, 1) - maxEnd
        End If
        
    ' Update latest end time
        
        If varData(i, 2) > maxEnd Then
            maxEnd = varData(i, 2)
            
        End If
        
    Next i
    
' Output

    Range("I1:j6").Clear
    Range("I1:j1").Font.Bold = True
    Range("I1:J1").HorizontalAlignment = xlCenter
    Range("j2:j3").NumberFormat = "dd/mm/yyyy hh:mm:ss"
    Range("j4:j6").NumberFormat = "[h]:mm:ss"
    
    
    Range("I1").Value = "Measure"
    Range("J1").Value = "Value"
    
    Range("i2").Value = "Start"
    Range("j2").Value = minStart
    
    Range("i3").Value = "End"
    Range("j3").Value = maxEnd
    
    Range("i4").Value = "Duration"
    Range("j4").Value = maxEnd - minStart
    
    Range("i5").Value = "Gaps"
    Range("j5").Value = gap
    
    Range("i6").Value = "Net"
    Range("j6").Value = maxEnd - minStart - gap
    
End Sub

这使用与问题中相同的连续测试数据，但格式为日期时间：

这是一个 UDF 版本，它只返回任务的净时间。

Function TimeOnTask(R As Range) As Variant

    Dim varData As Variant
    Dim minStart As Variant
    Dim maxEnd As Variant
    Dim i As Long
    Dim gap As Variant
    


    ' Set the array

    varData = R.Value

    '  *** Modified code to remove bad data ***
    
    ' Remove elements that are not number or date

    Call RemoveInvalid(varData, lastUsed)

    ' Sort https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba

    Call QuickSortArray(varData, 1, lastUsed, 1)

    ' *** end of modified code ***


    ' Initialise
      
    minStart = varData(1, 1)
    maxEnd = varData(1, 1)
    gap = 0
    
    ' Loop over rows

    ' *** This line also modified ***

    For i = 1 To lastUsed
    
    ' If there is a gap, increment total gap length
    
        If (varData(i, 1)) > maxEnd Then
            gap = gap + varData(i, 1) - maxEnd
        End If
        
    ' Update latest end time
        
        If varData(i, 2) > maxEnd Then
            maxEnd = varData(i, 2)
            
        End If
        
    Next i
    
    
    TimeOnTask = maxEnd - minStart - gap
    
End Function

** 编辑 **

我试图通过添加一个简短的例程来删除开始时间或停止时间不是数字或日期的行来使其更加健壮（另请参阅上面的修改代码）：

Sub RemoveInvalid(ByRef arr As Variant, ByRef lastUsed As Long)
    Dim i As Long
    Dim j As Long
    
    j = 0
    
    For i = 1 To UBound(arr, 1)

    ' Increment and copy row if valid

        If (IsNumeric(arr(i, 1)) Or IsDate(arr(i, 1))) And Not (IsEmpty(arr(i, 1))) And _
           (IsNumeric(arr(i, 2)) Or IsDate(arr(i, 2))) And Not (IsEmpty(arr(i, 2))) Then
            j = j + 1
            arr(j, 1) = arr(i, 1)
            arr(j, 2) = arr(i, 2)
        End If
    Next i
    
    lastUsed = j
              
        
End Sub

没有必要重新调整数组，因为您可以在快速排序调用以及间隙和孤岛循环中指定最后使用的行。