Håber du kan bruge følgende VBA Sub:
Sub Arbejdstid()
Dim colTidspunkt As New Collection
Dim t As Double
Dim mødetid As Double
Dim fyraften As Double
Dim tillægstid As Double
Dim i As Integer
Dim iMødetid As Integer
Dim iFyraften As Integer
Ark1.Rows(1).NumberFormat = "hh:mm"
t = 1 / 3#
colTidspunkt.Add t, "T1"
t = 3 / 4#
colTidspunkt.Add t, "T2"
t = 4 / 3#
colTidspunkt.Add t, "T3"
t = 7 / 4#
colTidspunkt.Add t, "T4"
t = 2#
colTidspunkt.Add t, "T5"
mødetid = Ark1.Cells(1, "A").Value
fyraften = Ark1.Cells(1, "B").Value
If mødetid > fyraften Then fyraften = fyraften + 1
Ark1.Cells(1, "C").Value = fyraften - mødetid
i = 1
Do While mødetid > colTidspunkt.Item(i)
i = i + 1
Loop
iMødetid = i
colTidspunkt.Add mødetid, "mødetid", i
Do While fyraften > colTidspunkt.Item(i)
i = i + 1
Loop
iFyraften = i
colTidspunkt.Add fyraften, "fyraften", i
tillægstid = 0#
For i = iMødetid To iFyraften - 1
If i / 2 - i \ 2 Then
tillægstid = tillægstid + colTidspunkt.Item(i + 1) - colTidspunkt.Item(i)
End If
Next i
Ark1.Cells(1, "D").Value = tillægstid
Set colTidspunkt = Nothing
End Sub
MVH
ELM