Automatisch datum+tijd + cel laten verspringen VBA

[Ridegroot]

Bekijk bijlage Urenregistratie REV0.xlsm

Goede dag

d.m.v. een barcode scanner wil ik zonder toetsen of muis gegevens invoeren in cel A, B + C wanneer C is ingevoerd dient de selectie naar de volgende regel te gaan en weer bij A te beginnen.

daarnaast dient automatisch de start datum + tijd bij D de verschijnen (werk al, misschien kan het anders beter?)

tot slot dient wanneer de zelfde persoon verschijnt in een nieuwe regel de eindtijd bij de vorige regel te verschijnen.

Zie voorbeeld van hoe ik het graag zou willen.

Lijkt mij een hele uitdaging, wie kan dit

Bij voorbaat dank

 

[emields]

Zelfs als de starttijd later is dan de eindtijd?

 

[Ridegroot]

Bedankt voor je vraag

in de praktijk zal dit niet kunnen omdat bij een nieuwe gegevensinvoer / regel je altijd later in de tijd bent dan de vorige regel

 

[sylvester-ponte]

ok, dus als de datum versprongen is ......

 

[Ridegroot]

:thumb:

de excel sheet wil ik inzetten als urenregistratie per dag

In de kolommen A t/m C wil ik data invoeren (d.m.v. barcode scanner) in de kollomen er naast wil ik dat er automatisch tijden worden geregistreerd (en a.d.h. daarvan uren worden berekend)

Alvast bedankt

 

[sylvester-ponte]

naar boven zoeken:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Temp As Range
    With ListObjects(1).DataBodyRange
        If Intersect(Target, .Columns(1)) Is Nothing Or Target.Count <> 1 Then Exit Sub
        Set Temp = Target(0)
Application.EnableEvents = False
        Target.Offset(, 3) = Now
            Do Until Intersect(Temp, .Cells) Is Nothing
                If Target = Temp Then Target(, 4) = Temp(, 5): Application.EnableEvents = True: Exit Sub
                Set Temp = Temp(0)
            Loop
    End With
Application.EnableEvents = True
End Sub

 

[Ridegroot]

Bedankt voor de input, helaas krijg ik de code niet helemaal werkend. Ook twijfel ik of die helemaal werk zoals ik het graag wil (misschien niet goed uitgelegd)

voorbeeld

PIET werk 1 start: 1 uur stopt 2 uur (= start tijd werk 2)
PIET werk 2 start: 2 uur stopt 4 uur (= start tijd werk 1, onderste regel en niet bovenste)
HENK werk 2 start: 3 uur
PIET werk 1 start: 4 uur

is dit mogelijk?

 

[sylvester-ponte]

er zat een fout in: kijk eens of deze het doet: als er geen eindtijd staat wordt er een lege cel achter gelaten

 

[VenA]

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, ListObjects(1).DataBodyRange.Columns(1)) Is Nothing Or Target.Count <> 1 Then Exit Sub
  Target.Offset(, 3) = Now
  ar = ListObjects(1).Range
  For j = 1 To UBound(ar)
    If ar(j, 1) = Target.Value And Target.Row <> j And ar(j, 5) = "" Then
        ListObjects(1).Range.Cells(j, 5) = Now
        Exit For
      End If
    Next j
End Sub

 

[Ridegroot]

Super de laatste werkt perfect enorm bedankt ook sylvester.

Nog een laatste wens zou mooi zijn maar ik weet niet of dit kan:



Zie vooorbeeld

Bekijk bijlage Urenregistratie REV1.xlsm

Het zou mooi zijn dat er bij het woord KOFFIE altijd 15 min word afgetrokken van lopende regels en om het compleet te maken zou er bij het verschijnen van het woord LUNCH 30 min van de lopende regels wordt afgetrokken / ingehouden van de eind tijd. Dus zodra de eindtijd verschijnt dienen de pauzes niet te worden meegenomen.

PS 15 en 30 min is standaard en hoeft niet appart te worden bijgehouden

erg lastig te maken lijkt mij, is dit uberhaubt mogelijk?

 

[sylvester-ponte]

het lijkt mij dat je dat bij totale uren moet doen niet bij de eindtijd.

ps er gebeuren vreemde dingen : vul in de door jouw gestuurde oplossing een HENK in en kijk wat er gebeurt.

een eerdere HENK wordt dan de eindtijd van ingevuld, is dat de bedoeling?

 

[Ginger]

Op basis van de opmerking van SP hierboven...
Maak een kloksysteem altijd op basis van een personeelsnummer (of persoonsnummer) en nooit op basis van naam. Zo'n nummer kan je dan ook als barcode inzetten en is alles scanbaar.

 

[VenA]

Zoiets?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, ListObjects(1).DataBodyRange.Columns(1)) Is Nothing Or Target.Count <> 1 Then Exit Sub
  Application.EnableEvents = False
  Target.Offset(, 3) = Now
  If InStr(1, "koffielunch", Target.Value, 1) Then Target.Offset(, 4) = Now + IIf(LCase(Target.Value) = "koffie", "0,25", "0,50") / 24
  With ListObjects(1)
    ar = .DataBodyRange
    For j = 1 To UBound(ar)
      If Target.Row > j And ar(j, 5) = "" Then
        If InStr(1, "koffielunch", Target.Value, 1) Then
          ar(j, 6) = ar(j, 6) - IIf(LCase(Target.Value) = "koffie", 0.25, 0.5)
          ElseIf LCase(Target.Value) = LCase(ar(j, 1)) Then
            ar(j, 5) = Now
            ar(j, 6) = ar(j, 6) + Round((ar(j, 5) - ar(j, 4)) * 24, 2)
            Exit For
        End If
      End If
    Next j
    .DataBodyRange = ar
  End With
  Application.EnableEvents = True
End Sub

 

[Ridegroot]

Wederom bedankt, helaas krijg ik diverse foutmeldingen met dit script.

 

[VenA]

Als je diverse foutmeldingen krijgt dan is het handig om te vermelden wat de foutmeldingen zijn en op welke regel het fout gaat.

Probeer het zo eens.

 

[Ridegroot]

Het lijkt goed te werken nu. Je bent super :thumb:. Deze week ga ik er mee proef draaien