Berækning av obekvæm arbetstid

Hej nyholm. Hermed en udvidet version af den tidligere kode:


Private Sub Test_BeregnTid()
  Const StartTid = #10:00:00 PM#
  Const SlutTid = #4:00:00 AM#
  Const StartDag = #2/6/2009#
  Const SlutDag = #2/7/2009#
  Debug.Print Format(StartDag, "ddd"); " "; Format(StartTid, "hh:nn"); " - " & _
              Format(SlutDag, "ddd"); " "; Format(SlutTid, "hh:nn"); _
              "  OB1:"; BeregnTid(StartTid, SlutTid, StartDag, SlutDag, 1); _
              "  OB2:"; BeregnTid(StartTid, SlutTid, StartDag, SlutDag, 2)
End Sub


'OB1 = måndag (1) kl 06.00 till lørdag (6) kl 19.00
'OB2 = lørdag (6) kl 19.00 till måndag (1) kl 06.00
Function BeregnTid(StartKl As Date, SlutKl As Date, StartDag As Date, SlutDag As Date, OBtype As Integer) As Single
  Const KlokkenNitten = #7:00:00 PM#
  Const KlokkenSeks = #6:00:00 AM#
 
  Dim StartWeekDay As Integer
  Dim SlutWeekDay As Integer
  Dim Tid As Date
 
  StartWeekDay = Weekday(StartDag, vbMonday)
  SlutWeekDay = Weekday(SlutDag, vbMonday)
 
  Tid = 0
  If StartKl < SlutKl Then  ' Krydser ikke midnat
   
    ' Morgen
    If SlutKl < KlokkenNitten Then
      If StartKl < KlokkenSeks Then
        Select Case OBtype
          Case 1
            If StartWeekDay >= 2 And StartWeekDay <= 6 Then
              Tid = Min(SlutKl, KlokkenSeks) - StartKl
            End If
          Case 2
            If StartWeekDay = 1 Or StartWeekDay = 7 Then
              Tid = Min(SlutKl, KlokkenSeks) - StartKl
            End If
        End Select
      End If
    ' Aften
    Else
      Select Case OBtype
        Case 1
          If StartWeekDay >= 1 And StartWeekDay <= 5 Then
            Tid = SlutKl - Max(StartKl, KlokkenNitten)
          End If
        Case 2
          If StartWeekDay = 6 Or StartWeekDay = 7 Then
            Tid = SlutKl - Max(StartKl, KlokkenNitten)
          End If
      End Select
      ' + evt morgen
      If StartKl < KlokkenSeks Then
        Select Case OBtype
          Case 1
            If StartWeekDay >= 2 And StartWeekDay <= 6 Then
              Tid = Tid + KlokkenSeks - StartKl
            End If
          Case 2
            If StartWeekDay = 1 Or StartWeekDay = 7 Then
              Tid = Tid + KlokkenSeks - StartKl
            End If
        End Select
      End If
    End If
 
  Else                      ' Krydser midnat
    ' Aften
    If StartKl < KlokkenNitten Then
      Select Case OBtype
        Case 1
          If StartWeekDay >= 1 And StartWeekDay <= 5 Then
            Tid = DateAdd("n", 1, #11:59:00 PM# - KlokkenNitten)
          End If
        Case 2
          If StartWeekDay = 6 Or StartWeekDay = 7 Then
            Tid = DateAdd("n", 1, #11:59:00 PM# - KlokkenNitten)
          End If
      End Select
    Else
      Select Case OBtype
        Case 1
          If StartWeekDay >= 1 And StartWeekDay <= 5 Then
            Tid = DateAdd("n", 1, #11:59:00 PM# - StartKl)
          End If
        Case 2
          If StartWeekDay = 6 Or StartWeekDay = 7 Then
            Tid = DateAdd("n", 1, #11:59:00 PM# - StartKl)
          End If
      End Select
    End If
    ' Morgen
    Select Case OBtype
      Case 1
        If SlutWeekDay >= 2 And SlutWeekDay <= 6 Then
          Tid = Tid + Min(SlutKl, KlokkenSeks)
        End If
      Case 2
        If SlutWeekDay = 1 Or SlutWeekDay = 7 Then
          Tid = Tid + Min(SlutKl, KlokkenSeks)
        End If
    End Select
   
  End If
  BeregnTid = Hour(Tid) + Minute(Tid) / 60
End Function

Hej fdata!
Tack før ditt svar.
Jab behøver ha saret på hur mycket som ær OB1 før sig och OB2 før sig. Før OB1 och OB2 betalas næmligen olika mycket i ersættning per tim.

... og det er præcis, hvad du får ;o)
Jeg har jo sendt en lille test-rutine, som illustrerer dette.

BeregnTid(StartTid, SlutTid, StartDag, SlutDag, 1) giver OB1
BeregnTid(StartTid, SlutTid, StartDag, SlutDag, 2) giver OB2

OK, nu har jag fått det att fungera.
Tack så mycket!

Bra! Tackar för point ;o)