datum en tijd vergelijken met de huidige datum en tijd om de ingevoerde gegevens te v

[abracadaver909]

Deze vraag gaat verder op een ouder topic: http://www.helpmij.nl/forum/showthr...lectie-zonder-celformat?p=5525401#post5525401

Hallo helpmij-ers,

Van werk uit de vraag gekregen ook een tijd in te voeren.
Het vergelijken van de datums in de range met de huidige datum is gelukt (zie hierboven). Echter is er nu een column toegevoegd met tijden (per kwartier uit een keuzelijst, column U).

Het script moet nu dus datum en tijd vergelijken met de huidige datum en tijd om de ingevoerde gegevens te verplaatsen naar een ander veld. Mijn probleem is dat de datum en tijd in verschillende columns staan.

Hoe ga ik dit in vredesnaam voor elkaar krijgen?
Hier is een voorbeeld: (uploaden van bestand lukt niet, krijg telkens foutmelding. Wel een plaatje toegevoegd..)

Option Explicit

Sub bomwalsen()

Application.ScreenUpdating = False


Dim datum As Range
Dim tijd As Range
Dim SelRange As Range
Dim SelRange2 As Range

For Each datum In Range("V20:V40")
If Len(datum.Value) > 0 And CDate(datum.Value) <= Date And TimeValue(datum.Offset(0, -1).Value) <= Now() Then

datum.Select
Selection.Offset(0, -5).Resize(2, 3).Select
Set SelRange = Selection

Else: GoTo Volgende
End If
 
'selecteert bovenste cel in range
Range("N20:N41").Cells(1).Select

'van geselcteerde cel wordt bepaalt of deze inhoud heeft. Zoja, dan cel daaronder selecteren en deze actie herhalen. zonee, plakken wat gekopieert is.
Do While Len(ActiveCell.Value) > 0
   Selection.Offset(2).Resize(2, 2).Select
Loop
Set SelRange2 = Selection
SelRange2.Value = SelRange.Value
Selection.Resize(1, 1).Offset(0, -1).Value = "incident"

    
datum.Select
Selection.Offset(0, -4).Resize(2, 5).Value = Empty


Volgende:
Next

Application.ScreenUpdating = True

End Sub

Bij voorbaat dank (alweer ),

Chris

 

[snb]

Welke extensie heeft je bestand dan ?

 

[abracadaver909]

Het bestand is een xls.

 

[mastermindzh]

Beste abracadaver909,

Ik heb je vraag even een eigen (nieuwe) topic gegeven.

 

[abracadaver909]

Dank u.

 

[edmoor]

Als je zegt een foutmelding te krijgen kan je die er beter ook bij vermelden.

 

[snb]

Hoe groot is het bestand dat je wil uploaden ?

 

[abracadaver909]

400 kb

Ik zal kijken welke melding ik krijg en post het dan

 

[abracadaver909]

Hallo, eindelijk weer eens tijd gevonden om dit weer op te pakken, mijn excuses!

Ik heb een uitgeklede versie gepost en gefocust op mijn probleem:

Bekijk bijlage voorbeeld.xls

Wanneer de tijd en datum in respectievelijke columns U en V kleiner of gelijk zijn aan huidige tijd en datum, dan moeten de gegevens in columns Q,R en S naar respectievelijke columns M,N en O verplaatst worden.

De macro die ik nu heb triggert slechts alleen op datum, omdat ik niet weet hoe ik het zover krijg dat er óók naar de tijd wordt gekeken om de macro te laten triggeren (dit komt uiteindelijk in een timer terecht, in plaats van een knop)

Dit is het werkende stukje macro zonder tijd:

Option Explicit

Sub bomwalsen()

Application.ScreenUpdating = False


Dim datum As Range
Dim SelRange As Range
Dim SelRange2 As Range

For Each datum In Range("V20:V40")
If Len(datum.Value) > 0 And CDate(datum.Value) <= Date Then

datum.Select
Selection.Offset(0, -5).Resize(2, 3).Select
Set SelRange = Selection

Else: GoTo Volgende
End If
 
'selecteert bovenste cel in range
Range("N20:N41").Cells(1).Select

'van geselecteerde cel wordt bepaalt of deze inhoud heeft. Zoja, dan cel daaronder selecteren en deze actie herhalen. zonee, plakken wat gekopieerd is.
Do While Len(ActiveCell.Value) > 0
   Selection.Offset(2).Resize(2, 2).Select
Loop
Set SelRange2 = Selection
SelRange2.Value = SelRange.Value
Selection.Resize(1, 1).Offset(0, -1).Value = "incident"

    
datum.Select
Selection.Offset(0, -4).Resize(2, 5).Value = Empty


Volgende:
Next

Application.ScreenUpdating = True

End Sub

En zo probeerde ik het met tijd:

Option Explicit

Sub bomwalsen()

Application.ScreenUpdating = False


Dim datum As Range
Dim tijd As Date
Dim SelRange As Range
Dim SelRange2 As Range

tijd = Now()
For Each datum In Range("V20:V40")
If Len(datum.Value) > 0 And CDate(datum.Value) <= Date And TimeValue(datum.Offset(0, -1).Value) <= tijd(Format(tijd, "h:mm")) Then

datum.Select
Selection.Offset(0, -5).Resize(2, 3).Select
Set SelRange = Selection

Else: GoTo Volgende
End If
 
'selecteert bovenste cel in range
Range("N20:N41").Cells(1).Select

'van geselecteerde cel wordt bepaalt of deze inhoud heeft. Zoja, dan cel daaronder selecteren en deze actie herhalen. zonee, plakken wat gekopieerd is.
Do While Len(ActiveCell.Value) > 0
   Selection.Offset(2).Resize(2, 2).Select
Loop
Set SelRange2 = Selection
SelRange2.Value = SelRange.Value
Selection.Resize(1, 1).Offset(0, -1).Value = "incident"

    
datum.Select
Selection.Offset(0, -4).Resize(2, 5).Value = Empty


Volgende:
Next

Application.ScreenUpdating = True

End Sub

Ik weet dat het ergens in de "tijd-voorwarde" niet goed is gescrypt en ik heb ook geen flauw idee hoe ik dit wel voor elkaar moet krijgen.
Ik hoop dat ik jullie hiermee voldoende info heb verschaft om me enig inzicht te geven hierin.

Bij voorbaat dank!