Werken met tijdsarrays

[Fill123]

Hallo,

Ik ben met een projectje bezig waar het niet goed mee wil lukken.
De code hier bijgevoegd is het deel van de code dat niet goed werkt.
Ik heb verschillende tijdstippen met een marge van 30 minuten.
Er moet 15 keer ingelezen kunnen worden per 24 uur. Er zijn 5 tijdstippen per shift en dit in 3 shiften.
Het moet ook mogelijk zijn om eender wanneer het bestand te openen en in te lezen. Ongeacht of het voor of na middernacht is en dit is nu net het probleem.
Kort uitgelegd :
Er moet 5 keer per shift op een knop geklikt worden om data in te lezen (dit wordt op cellniveau gedaan uit een databank met de tijd uit cell A1).
Dit mag pas kunnen vanaf het tijdstip in de tijdsarray tot 30 minuten erna.
Als er te laat wordt geklikt mag er niks meer ingelezen worden -> msgbox
Als er te vroeg wordt geklikt mag er nog niet ingelezen worden -> msgbox
Als het binnen de tijd is wordt de data uit kolom D gekopiërd naar de overéénkomstige kolom van deze tijd.
Alles werkt prima tot het middernacht is geweest.

Ik hoop dat iemand me hier mee kan helpen.

Alvast bedankt

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim lastCol As Integer
Dim lastRow As Integer
Dim bronKolom As Integer
Dim tijdstippen As Variant
Dim i As Integer
Dim huidigeTijd As Date
Dim laatstBereikteTijd As Date
Dim tijdMetDatum As Date
Dim datumVoorTijdstip As Date

' Werkblad instellen
Set ws = ActiveSheet
bronKolom = 4 ' Kolom D, bron van de gegevens

' Tijdstippen voor alle shifts
tijdstippen = Array("06:00", "07:45", "09:15", "10:45", "12:15", _
"14:00", "15:45", "17:15", "18:45", "20:15", _
"22:00", "23:45", "01:15", "02:45", "04:15")

' Huidige tijd bepalen en opslaan in A1
huidigeTijd = Now
ws.Cells(1, 1).Value = huidigeTijd

' **Zoek het laatst gepasseerde tijdstip**
laatstBereikteTijd = 0 ' Standaardwaarde

For i = LBound(tijdstippen) To UBound(tijdstippen)
' **Bepaal de juiste datum voor het tijdstip**
If TimeValue(tijdstippen(i)) >= TimeValue("22:00") Then
datumVoorTijdstip = Date ' 22:00 en 23:45 horen bij de huidige dag
ElseIf TimeValue(tijdstippen(i)) < TimeValue("06:00") Then
If Not IsEmpty(ws.Cells(3, 4).Value) Then
' Controleer de laatst ingelezen tijd in D3
If ws.Cells(3, 4).Value < Date Then
datumVoorTijdstip = Date ' D3 staat op gisteren, blijf bij vandaag
Else
datumVoorTijdstip = Date + 1 ' Schuif deze tijden naar morgen
End If
Else
' Als D3 leeg is, bepaal de datum zoals normaal
If Hour(huidigeTijd) < 6 Then
datumVoorTijdstip = Date - 1 ' Na middernacht, hoort bij gisteren
Else
datumVoorTijdstip = Date ' Overdag blijft het gewoon vandaag
End If
End If
Else
datumVoorTijdstip = Date ' Overige tijden horen bij vandaag
End If

' Maak volledige datum/tijd voor vergelijking
tijdMetDatum = datumVoorTijdstip + TimeValue(tijdstippen(i))

' **Bepaal het laatst bereikte tijdstip**
If huidigeTijd >= tijdMetDatum Then
laatstBereikteTijd = tijdMetDatum ' Update het laatst bereikte tijdstip
Else
' Controleer of we te vroeg zijn (meer dan 45 minuten te vroeg)
If huidigeTijd > tijdMetDatum - TimeValue("00:45") Then
MsgBox "Je bent te vroeg voor het tijdstip: " & tijdstippen(i) & "!", vbExclamation, "Te Vroeg!"
Exit Sub
End If
Exit For ' Stop zodra we een toekomstig tijdstip vinden
End If
Next i

' **Update D3 alleen als een geldige tijd is gevonden**
If laatstBereikteTijd > 0 Then
ws.Cells(3, 4).Value = laatstBereikteTijd
Else
MsgBox "Er is nog geen tijdstip gepasseerd.", vbExclamation, "Geen geldig tijdstip"
Exit Sub
End If

' **Controle of inlezen nog mogelijk is (binnen 30 minuten)**
If huidigeTijd > laatstBereikteTijd + TimeValue("00:30") Then
MsgBox "Je kunt niet meer inlezen voor het tijdstip " & Format(laatstBereikteTijd, "HH:mm") & "!", vbExclamation, "Te Laat!"
Exit Sub
End If

' **Bepaal in welke kolom de data moet komen**
lastCol = 7 + Application.Match(Format(laatstBereikteTijd, "HH:mm"), tijdstippen, 0) - 1
lastRow = ws.Cells(Rows.Count, bronKolom).End(xlUp).Row

' **Controle of er al gegevens zijn ingelezen**
If Not IsEmpty(ws.Cells(3, lastCol).Value) Then
MsgBox "De gegevens voor dit tijdstip zijn al ingelezen.", vbExclamation, "Al verwerkt"
Exit Sub
End If

' **Plak de gegevens in de juiste kolom**
ws.Range(ws.Cells(3, bronKolom), ws.Cells(lastRow, bronKolom)).Copy
ws.Cells(3, lastCol).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

' **Opslaan van het werkblad**
ActiveWorkbook.Save

' **Stop de timer en markeer het inlezen als voltooid**
inlezenVoltooid = True
StopTimer
End Sub

 

[OctaFish]

I.p.v. code kun je beter een bestandje meesturen. Of verwacht je van ons dat wij het gaan nabouwen? Overigens kun je de juiste datum voor de ochtenduren na 24:00 natuurlijk makkelijk bepalen a.d.h.v. Het indexnummer van de array.