Tijdstip vullen binnen een bereik en vervangen door bepaalde karakters

[Robert Smidt]

Hallo Helpmijers,

Ik ben bezig om een rooster in Excel te maken en wil graag binnen een bereik van A4 t/m V90 - wanneer ik bijv. een 9 plaats - dat het systeem hier automatisch 09:00 van maakt. Voorgaande geld voor alle hele uren van 9 uur t/m 21 uur.

Alvast bedankt voor de medewerking.

Groeten, Robert

 

[spaarie]

Misschien kan het mooier, maar hierbij een poging tot

Private Sub Worksheet_Change(ByVal target As Range)
  If Not Intersect(target, Sheets(1).Range("A4:V90")) Is Nothing Then
    If Len(target) = 1 Then target.Value = "0" & target & ":00"
    If Len(target) = 2 Then target.Value = target & ":00"
  End If
End Sub

 

[Robert Smidt]

Bedankt voor de snelle reactie.

Hij werkt bijna perfect, het enige is dat wanneer ik een alfanumeriek plaats hij er ook :00 aan toevoegd. Het is de bedoeling dat de wijziging alleen betrekking heeft op numerieke getallen. In sommige gevallen plaats ik ook een "V" van verlof of "Z" van "ziek".

Ik hoop dat het lukt om dit te veranderen.

 

[Robert Smidt]

Private Sub Worksheet_Change(ByVal Target As Range)
'we are only interested in A94-V93 'Range("A4:V93")
If Not (Intersect(Target, Range("A9:V93")) Is Nothing) Then
'if there are multiple cells selected we need to process them all
If Len(Target) = 1 Then Target.Value = "0" & Target & ":00"
If Len(Target) = 2 Then Target.Value = Target & ":00"
Dim c As Range
For Each c In Target.Cells
'see if the user entered a 'z'or 'V'
If UCase(c.Value) = "Z" Or UCase(c.Value) = "V" Or UCase(c.Value) = "U" Or UCase(c.Value) = "ZW" Or UCase(c.Value) = "X" Then
'clear the two cells next to the target
Dim rToClear As Range
Set rToClear = Range(c.Offset(0, 1), c.Offset(0, 2))
rToClear.Value = ""
End If
Next
End If
End Sub

 

[spaarie]

Private Sub Worksheet_Change(ByVal target As Range)
  If Not Intersect(target, Sheets(1).Range("A4:V90")) Is Nothing Then
    If Not IsNumeric(target) Then Exit Sub
    If Len(target) = 1 Then target.Value = "0" & target & ":00"
    If Len(target) = 2 Then target.Value = target & ":00"
  End If
End Sub

 

[Robert Smidt]

Super bedankt, het werkt helemaal perfect. Onderstaand kun je zien waar ik de code heb geplaatst en alle activiteiten werken....ik ga er nog even mee testen maar ga ervan uit dat het stabiel is...nogmaal heel erg bedankt.

Private Sub Worksheet_Change(ByVal Target As Range)
'we are only interested in A94-V93 'Range("A4:V93")
If Not (Intersect(Target, Range("A9:V93")) Is Nothing) Then
'if there are multiple cells selected we need to process them all
Dim c As Range
For Each c In Target.Cells
'see if the user entered a 'z'or 'V' etc.
If UCase(c.Value) = "Z" Or UCase(c.Value) = "V" Or UCase(c.Value) = "U" Or UCase(c.Value) = "ZW" Or UCase(c.Value) = "X" Then
'clear the two cells next to the target
Dim rToClear As Range
Set rToClear = Range(c.Offset(0, 1), c.Offset(0, 2))
rToClear.Value = ""
End If
If Not IsNumeric(Target) Then Exit Sub
If Len(Target) = 1 Then Target.Value = "0" & Target & ":00"
If Len(Target) = 2 Then Target.Value = Target & ":00"
Next
End If
End Sub