excel - 查找连续数据所花费的时间

Question

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

我的数据集可能如下所示: (在第一次建议后更新了数据集)

<表类=“s-表”> <标题> 开始时间 结束时间 <正文> 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

间隙和孤岛解决方案实际上是一段非常短的代码 - 大部分是输出。我正在使用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

无需重新调整数组，因为您只需在快速排序调用以及间隙和岛循环中指定最后使用的行即可。