11. marts 2008 - 22:02
Der er
4 kommentarer og
1 løsning
Udregning af timer
Hej Måske der er en der kan hjælpe mig da jeg ingen styr har på excell overhovedet. Jeg bruger excel til at lave vagtplan i, mest fordi det er så dejligt let at overskue. Nu vil jeg gerne hvis jeg på en måde kan gøre det lidt mere automatisk. exempel.
Kan jeg regne timerne sammen automatisk selvom jeg skriver tid i arket. Jeg mener her at jeg ud for mandag ved et navn har en tid der hedder 10.30-18.00 næste navn står der så 18.00-01.00
Kan det lade sig gøre at regne dette ud automatisk så jeg når jeg laver vagtplanen, løbende kan se hvor mange timer der bruges ved hver enkelt person ???
Meget svært at forklare, Jeg kan sende en kopi af planen hvis du ønsker det ???
26. marts 2008 - 18:51
#3
Resultatet blev følgende:
Rem Model 3 - 13-03-2008
Rem ====================
Const UgeStartRæk = 3
Const UgeDagStartKol = 2
Dim flag As Boolean, tid1, tid9, åbnRæk, lukRæk
Private Sub CommandButton1_Click() 'Nulstil vagter = Fri
Dim vagt
flag = True
For Each vagt In Range("A3:N20")
If vagt.Font.Size = 14 And IsNumeric(vagt) = False Then
vagt.Value = "Fri"
End If
Next
Rem Slet totaler - Kolonne 0 & P (Medarb.Uge-tim | ÅbnLuk-tim)
Range("O3:P20").ClearContents
flag = False
End Sub
Private Sub worksheet_activate()
flag = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range) 'Aktiveres ved ændringer i arket
If Target.Font.Size = 14 And IsNumeric(Target) = False And flag = False Then
flag = True
beregnTimer
flag = False
End If
End Sub
Sub beregnTimer()
Dim vagt, vagtTimer, medArbejder, dag, uge
Rem Slet totaler - Kolonne 0 & P (Medarb.Uge-tim | ÅbnLuk-tim)
Range("O3:P20").ClearContents
ræk = UgeStartRæk
For uge = 1 To 4
kol = UgeDagStartKol
For dag = 1 To 7
Rem nulstil tidligste & seneste tid
tid1 = 0
tid9 = 0
For medArbejder = 1 To 3
vagt = Cells(ræk, kol)
If vagt <> "" Then
vagtTimer = beregnVagtTimer(vagt, ræk, kol)
Cells(ræk, 15) = Cells(ræk, 15) + vagtTimer
End If
ræk = ræk + 1
Next medArbejder
Rem Beregn tillæg for åbne/lukketid á 0,5 time for dagen
If tid1 > 0 And tid9 > 0 Then
Cells(åbnRæk, 16) = Cells(åbnRæk, 16) + 0.5
Cells(lukRæk, 16) = Cells(lukRæk, 16) + 0.5
End If
ræk = UgeStartRæk + ((uge - 1) * 5)
kol = kol + 2
Next dag
ræk = UgeStartRæk + (uge * 5)
Next uge
End Sub
Private Function beregnVagtTimer(vagt, ræk, kol)
Dim fra, til, nFra, nTil
If LCase(vagt) = "fri" Then
beregnVagtTimer = 0
Else
fra = Left(vagt, 2)
til = Mid(vagt, 4, 2)
If IsNumeric(fra) = True And IsNumeric(til) = True Then
nFra = Val(fra)
nTil = Val(til)
If nTil < nFra Then
nTil = nTil + 24
End If
Rem beregn tidligste & seneste tid
If tid1 = 0 Then
tid1 = nFra
åbnRæk = ræk
Else
If nFra < tid1 Then
tid1 = nFra
åbnRæk = ræk
End If
End If
If tid9 = 0 Then
tid9 = nTil
lukRæk = ræk
Else
If nTil > tid9 Then
tid9 = nTil
lukRæk = ræk
End If
End If
beregnVagtTimer = nTil - nFra
Else
MsgBox ("Tidsperiode(2) ej numerisk: " + vagt)
beregnVagtTimer = 0
End If
End If
End Function
