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

Status
Niet open voor verdere reacties.
A

abracadaver909

Gebruiker
Lid geworden
12 mrt 2011
Berichten
94
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..)

rolls.jpg

Code: 
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
 
Laatst bewerkt door een moderator:
Welke extensie heeft je bestand dan ?
 
Beste abracadaver909,

Ik heb je vraag even een eigen (nieuwe) topic gegeven. :)
 
Als je zegt een foutmelding te krijgen kan je die er beter ook bij vermelden.
 
Hoe groot is het bestand dat je wil uploaden ?
 
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:
Code: 
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:
Code: 
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!
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan