Hulp maken urenregistratie systeem

[BastiaanLier]

Allen,

Ik werk als assistent in een ziekenhuis en wij moeten sindskort onze gemaakte uren gaan bijhouden.
Hiervoor ben ik bezig een opzetje te maken echter ik loop op een paar punten vast. Hierbij zou ik eenieders input ten zeerste waarderen!
In bijgevoegd bestand heb ik dus de opzet die ik tot nu toe heb gezet. Een kleine toelichting:
In het eerste werkblad staan alle essentiele gegevens voor het werkrooster. Zoals begin van de dag, eindtijd van werken, evt gewerkte diensturen (dus niet de standaard uren), de gemaakte dienst kmers (deze worden wel vergoedt namelijk...) en dan het totaal aan uren.
In het tweede werkblad moet een registratie komen van hetgeen wij tijdens de diensten doen buiten ""kantoortijden". Deze diensten doen wij vanuit huis en een of twee keer per week. Sommige telefoontjes kunnen wij idd telefonisch af en soms moeten wij naar het ziekenhuis toe. Nu doen wij dienst voor 6 ziekenhuizen, maar in principe gaan we maar naar 4 locaties toe! In dit werkblad moet genoteerd worden op welke dag je wat hebt gedaan, in welk ziekenhuis, hoeveel km je hebt gereden en begin en eindtijd.

Nu de volgende wensen:
Ik zou graag willen dat hetgeen in het tweede werkblad wordt ingevuld automatisch wordt genoteerd in het eerste werkblad. Is dit mogelijk? Dus dat de totaal gewerkte diensttijd uit het tweede werkblad automatisch wordt geregistreerd in het eerste werkblad in de kolom dienst. Tevens dat het totaal aantal dienstkm direct wordt geregistreerd in het eerste werkblad.

Wie kan mij hiermee helpen??

Alvast dank,
BasBekijk bijlage dienst ass.xls

 

[koster1984]

Lost deze code je probleem op?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A4:F103]) Is Nothing Then
Dim c As Range
    Set c = Sheets(1).Range("A" & Sheets(1).Range("A8").End(xlDown).Row + 1)
    If Target.Column = 1 Then
        c.Value = Target
        c.Offset(, 5).FormulaR1C1 = "=(RC[-3]-RC[-4])+RC[-2]"
        With c.Offset(1)
                        .ClearContents
                        .Font.Bold = False
        End With
        With c.Offset(2)
                        .Value = "Totaal"
                        .Font.Bold = True
        End With
        With c.Offset(1, 4)
                        .ClearContents
                        .Borders(xlEdgeTop).LineStyle = xlNone
        End With
        With c.Offset(1, 5)
                        .ClearContents
                        .Borders(xlEdgeTop).LineStyle = xlNone
        End With
        With c.Offset(2, 4)
                        .Borders(xlEdgeTop).LineStyle = xlDouble
                        .FormulaR1C1 = "=SUM(R[-" & c.Row - 6 & "]C:R[-2]C)"
        End With
        With c.Offset(2, 5)
                        .Borders(xlEdgeTop).LineStyle = xlDouble
                        .FormulaR1C1 = "=SUM(R[-" & c.Row - 6 & "]C:R[-2]C)"
        End With
        End If
    If Target.Column = 4 Then
        Sheets(1).Cells(c.Row - 1, 2).Value = Format(Target, "H:MM")
    End If
    If Target.Column = 5 Then
        Sheets(1).Cells(c.Row - 1, 3).Value = Format(Target, "H:MM")
    End If
    If Target.Column = 6 Then
        Sheets(1).Cells(c.Row - 1, 5).Value = Target
    End If
End If
End Sub

 

[BastiaanLier]

Beste Koster 1984,
Dank voor het meedenken! Echter, de macro lijkt bij mij uberhaupt niets te doen... Dat ligt waarschijnlijk aan mij.
Ik heb de macro ingevoegd en laten lopen. Echter, er gebeurt niks. Idee?
Alvast dank,
Bas

 

[koster1984]

Ik denk dat je excel te oud is (of die van mij te nieuw).

Je kan wel de volgende formule in bijvoorbeeld F8, van Werktijden zetten:

=SOMPRODUCT(('Dienst specificatie'!A$4:A$103=A8)*('Dienst specificatie'!E$4:E$103-'Dienst specificatie'!D$4:D$103))

Het enige is dat de uitkomt negatief is wanneer bijvoorbeeld de begintijd 23:45 en de eindtijd 0:15 is (in de zin dat hij niet begrijpt dat 0:15 op de volgende dag valt), maar daar zou je ergens een datum bij kunnen invoegen.

 

[BastiaanLier]

Beste Koster,
Ik heb excel 2010... dus lijkt mij redelijk up to date...
kan jij anders de Macro in het meegestuurde bestand zetten?? kijken wat ie dan zou moeten doen...?!
Heel vaag dit... normaal gesproken werken de macros wel!
groet,
bas

 

[koster1984]

Het zat anders in een 97/03 formaat, bij deze in 2010 formaat:

 

[BastiaanLier]

Ha... oeps... mijn fout... werk excel en excel wat ik thuis heb zit idd groot verschil tussen...

In jouw versie werkt de macro idd... maar een vraagje... de macro lijkt de ingevulde gegevens van het werkblad dienst specificatie over te zetten naar het werkblad werktijden bij de totaal uren kolom.
Echter, is het mogelijk dat het totaal aantal diensturen op een dag, zoals deze worden genoteerd in het werkblad dienst specificatie (kunnen dus meerdere oproepen per dag zijn), in kolom D als totaal worden neergezet in het werkblad werktijden? Hetzelfde geldt dan voor het totaal aantal dienst KMeters.
Alvast dank voor de moeite!!
Groet,
Bas

 

[koster1984]

Deze code zoekt de ingevulde dag en bij invoer van een waarde in kolom...

E : ...telt ie de waarde van eindtijd - begintijd bij de waarde in het totaal op
F : ...telt ie de waarde op bij de waarde van de KMs​

Om hem echt de waardes actief te laten tellen vanuit het invulsheet (i.p.v. alleen bij het totaal op te tellen) zul je het probleem uit post #4 moeten oplossen door bij het invullen van de tijd ook een datum toe te kennen

Het enige is dat de uitkomt negatief is wanneer bijvoorbeeld de begintijd 23:45 en de eindtijd 0:15 is (in de zin dat hij niet begrijpt dat 0:15 op de volgende dag valt), maar daar zou je ergens een datum bij kunnen invoegen

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, c As Range
Set c = Sheets(1).Columns(1).Find(Cells(Target.Row, 1), , xlFormulas, xlWhole)
If c = "" Then GoTo einde
If Not Intersect(Target, [E4:E103]) Is Nothing Then
    c.Offset(, 5) = c.Offset(, 5) + (Target - Target.Offset(, -1))
End If
If Not Intersect(Target, [F4:F103]) Is Nothing Then
    c.Offset(, 4) = c.Offset(, 4) + Target
End If
Exit Sub
einde:
a = MsgBox("Dag bestaat niet", vbOKOnly, "Dag")
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End Sub

 

[koster1984]

In het geval van de kilometers heb je bovengenoemd probleem trouwens niet, dan zou het er voor dat stukje als volgt uitzien (en telt hij dus wel actief de km's per dag vanuit de invulsheet):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, c As Range
Set c = Sheets(1).Columns(1).Find(Cells(Target.Row, 1), , xlFormulas, xlWhole)
If c = "" Then GoTo einde
If Not Intersect(Target, [E4:E103]) Is Nothing Then
    c.Offset(, 5) = c.Offset(, 5) + (Target - Target.Offset(, -1))
End If
If Not Intersect(Target, [F4:F103]) Is Nothing Then
    c.Offset(, 4) = [COLOR="#FF0000"]WorksheetFunction.SumIf([A:A], c, [F:F])[/COLOR]
End If
Exit Sub
einde:
a = MsgBox("Dag bestaat niet", vbOKOnly, "Dag")
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End Sub

Zie ook toegepast in bestandje:

 

[koster1984]

Ik heb al wat gevonden met de volgende formule in H4:

=ALS(E4-D4<0;(E4+1)-D4;E4-D4)

In de bijlage nogmaals een bestand met bovenstaande oplossing (in vba én met somproduct-formules):