将分数应用于不同时间段

Question

这些是我的标准：

Monday to Friday:  
06:00 to 07:30 (2 points per hour)  
14:00 to 17:00 (1 point per hour)  
17:00 to 19:00 (2 points per hour)  
19:00 to 01:00 (3 points per hour)

Saturday  
06:00 to 17:00  (2 points per hour)  
17:00 to 01:00 (3 points per hour)  

Sunday  
06:00 to 17:00 (2 points per hour)  
17:00 to 01:00 (4 points per hour)

Monday to Friday:  
06:00 to 07:30 (2 points per hour)  
14:00 to 17:00 (1 point per hour)  
17:00 to 19:00 (2 points per hour)  
19:00 to 01:00 (3 points per hour)

Saturday  
06:00 to 17:00  (2 points per hour)  
17:00 to 01:00 (3 points per hour)  

Sunday  
06:00 to 17:00 (2 points per hour)  
17:00 to 01:00 (4 points per hour)

该代码在某些情况下存在问题。
第一个答案应该是 4.5
第二个答案应该是 12
第三个答案应该是 24。

Answer 1

对你的错误的评论

1. 5.5是正确的。1 分/小时 (2 小时 + .5 小时)*1 分/小时 = 2.5 分，2 分/小时组 = (1 小时 + .5 小时)*2 分/小时 = 3 分。总计 2.5+3 = 5.5
2. 我没有花足够的时间来找出原因，但当 currentTime 和 endTime 均为下午 1:00 时，它会进入 While 循环，即使使用“<”而不是“<=”
3. 1:30 超出了您的规则范围 星期六从 [17:00,01:00] 开始。而且我认为您会遇到任何超出第二天的范围的问题。

我没有通过计算半小时的“豆子”来计算分数，而是重新编写了它来查找相交的日期时间范围，并计算小时数的差值并应用乘数。

    Sub CalcOTPts()
        Dim startTime As Date, endTime As Date
        Dim timeString As String
        Dim oPts As Double
        
        Dim i As Integer
        For i = 30 To Cells(Rows.Count, "E").End(xlUp).Row
            timeString = Cells(i, "F").Value
            If InStr(1, timeString, "-") > 0 Then
                startTime = TimeValue(Split(timeString, "-")(0))
                endTime = TimeValue(Split(timeString, "-")(1))
                
                If endTime < startTime Then
                    endTime = DateAdd("d", 1, endTime)
                End If
    
                oPts = 0
                Select Case Cells(i, "E").Value
                    Case "Monday-Friday"
                        oPts = oPts + CalcPts(startTime, endTime, "6:00", "7:30", 2)
                        oPts = oPts + CalcPts(startTime, endTime, "14:00", "17:00", 1)
                        oPts = oPts + CalcPts(startTime, endTime, "17:00", "19:30", 2)
                        oPts = oPts + CalcPts(startTime, endTime, "19:00", "01:00", 3)
                    Case "Saturday"
                        oPts = oPts + CalcPts(startTime, endTime, "06:00", "17:00", 2)
                        ' Extended rule to 3:00 to test
                        oPts = oPts + CalcPts(startTime, endTime, "17:00", "03:00", 3)
                    Case "Sunday"
                        oPts = oPts + CalcPts(startTime, endTime, "06:00", "17:00", 3)
                        oPts = oPts + CalcPts(startTime, endTime, "17:00", "01:00", 4)
                End Select
                
                Cells(i, "M").Value = oPts
                
            End If
        Next
    End Sub
    
    
    Private Function CalcPts(ByVal startTime As Date, ByVal endTime As Date, startTimeRule As Date, endTimeRule As Date, multiplier As Double) As Double
        ' Finds the intersecting time between the two ranges and applies the hourly modifier
        
        Dim oStartIntersection As Date
        Dim oEndIntersection As Date
        
        ' Assume it's the next day if the endtime is less than starttime
        If endTimeRule < startTimeRule Then
            endTimeRule = DateAdd("d", 1, endTimeRule)
        End If
        
        CalcPts = 0     ' Default to not add any points
        If (startTime < endTimeRule) And (endTime > startTimeRule) Then
            'There is an intersection beween these two date ranges
            
            ' Find the start time for the intersection
            If startTime > startTimeRule Then
                oStartIntersection = startTime
            Else
                oStartIntersection = startTimeRule
            End If
            
            ' Find the end time for the intersection
            If endTime < endTimeRule Then
                oEndIntersection = endTime
            Else
                oEndIntersection = endTimeRule
            End If
            
            ' Calculate the points
            CalcPts = DateDiff("n", oStartIntersection, oEndIntersection) / 60 * multiplier
        End If
        
    End Function