Betinget formatering eller vba

=HVIS(A2=0;"";HVIS(A2<301;"17:00:00";HVIS(A2<501;"17:15:00";HVIS(A2<801;"17:30:00";HVIS(A2<1001;"17:45:00")))))

eller som kode i arkmodulet

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("A1:A1000")) Is Nothing Then
        Target.Offset(0, 6).NumberFormat = "hh:mm:ss;@"
        Select Case Target
        Case 0 To 300
            Target.Offset(0, 6) = #5:00:00 PM#
        Case 301 To 500
            Target.Offset(0, 6) = #5:15:00 PM#
        Case 501 To 800
            Target.Offset(0, 6) = #5:30:00 PM#
        Case Is > 800
            Target.Offset(0, 6) = #5:45:00 PM#
        End Select
    End If

End Sub

Hej
Det virker bare som det skal, vil der være fordele ved at lave det i vba. kontra betinget formatering.

Mvh/Henrik C

Jeg tror at det er smag og behag, men hvis andre skal bruge det, er formlen nok bedst, for så skal man ikke skrue på makrosikkerheden.

Hej
Der en del markoner i forvejen. så det er ikke et problem
formateringen kan man jo komme til at slette i cellen.

smid et svar da begge forslag kan bruges.

Mvh/Henrik C

Tak ;-))

Hej
jeg har et lille problem når jeg puter den i det ark hvor det skal bruges der er i forvejen denne.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2: A1000")) Is Nothing Then Target.Offset(0, 1) = Now

End Sub
og arket heder tid.
hvordan fixer jeg dette.

Mvh/Henrik C

det er jo samme område, så:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2: A1000")) Is Nothing Then
        Target.Offset(0, 1) = Now
        Target.Offset(0, 6).NumberFormat = "hh:mm:ss;@"
        Select Case Target
        Case 0 To 300
            Target.Offset(0, 6) = #5:00:00 PM#
        Case 301 To 500
            Target.Offset(0, 6) = #5:15:00 PM#
        Case 501 To 800
            Target.Offset(0, 6) = #5:30:00 PM#
        Case Is > 800
            Target.Offset(0, 6) = #5:45:00 PM#
        End Select
End Sub

mangler der ike et End If

Du har ret

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2: A1000")) Is Nothing Then
        Target.Offset(0, 1) = Now
        Target.Offset(0, 6).NumberFormat = "hh:mm:ss;@"
        Select Case Target
        Case 0 To 300
            Target.Offset(0, 6) = #5:00:00 PM#
        Case 301 To 500
            Target.Offset(0, 6) = #5:15:00 PM#
        Case 501 To 800
            Target.Offset(0, 6) = #5:30:00 PM#
        Case Is > 800
            Target.Offset(0, 6) = #5:45:00 PM#
        End Select
End if
End Sub

Hej
Tak skal i Have.

Mvh/Henrik C

Velbekomme, og tak for point.  :-)

tak for point