Fout 13 tijdens uitvoering

[marco001]

Hallo allemaal,

ik ben een planningsbestand aan het maken in excel, nu heb ik een probleem waar ik niet uitkom.

In het werkblad weekplanning wil ik graag dat de ingevoerde waarden direct omgezet worden in tijden. Dus als er 1230 ingevoerd word wil ik graag dat excel hier automatisch 12:30 van maakt. Na lang speuren voor een oplossing heb ik de volgende twee codes gevonden:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Union(Range("C5:P38"), Range("C43:P76"), _
Range("C82:P115"))) Is Nothing Then Exit Sub

'Door gebruik van Union zijn meerdere niet aaneengesloten selecties mogelijk.
'Zie onderstaande code.

'If Intersect(Target, Union(Range("J2:J6"), Range("J9:J13"), _
'Range("J16:J20"), Range("J23:J27"))) Is Nothing Then Exit Sub

  
  
  If IsEmpty(Target) Then Exit Sub

    ingave = Target.Value

   [B] If Hour(ingave) <> 0 Or Minute(ingave) <> 0 [/B]Then Exit Sub
    Application.EnableEvents = False

    If Int(ingave / 100) < 0.1 Then

        Target = "00:" & ingave

    Else

        Target = Int(ingave / 100) & ":" & Right(ingave, 2)

    End If

   Application.EnableEvents = True

End Sub

en:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("C5:P38")) Is Nothing Then
   [B] Minuut = Target Mod 100[/B]
    Uur = Int(Target / 100)
    Uur = Uur + Int(Minuut / 60): Minuut = Minuut Mod 60
    Uur = Uur Mod 24
    If Target > 1 Then Target = TimeValue(Uur & ":" & Minuut)
  End If
End Sub

Nu veranderen beide codes inderdaad de waarden in tijdsnotaties. Het probleem is alleen dat excel de volgende melding: "Fout 13 tijdens uitvoering: typen komen niet met elkaar overeen" geeft als ik meerdere cellen tegelijk wil deleten. Hetzelfde gebeurd als ik waarden kopieer en plak. De vetgedrukte delen geeft excel aan als fout.

Is er een manier om dit op te lossen? De planning is vaak in de basis hetzelfde dus het zou handig zijn als het deleten, kopiëren en plakken zou functioneren. Het bestand waarmee ik werk is bijgevoegd.

Alvast bedankt!

 

[rebmog]

Voeg de rode regels toe aan je 2e codevoorbeeld. Volgens mij is de foutmelding dan weg.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("C5:P38")) Is Nothing Then
    [COLOR="#FF0000"]If Target.Cells.Count = 1 Then[/COLOR]
        Minuut = Target Mod 100
        Uur = Int(Target / 100)
        Uur = Uur + Int(Minuut / 60): Minuut = Minuut Mod 60
        Uur = Uur Mod 24
        If Target > 1 Then Target = TimeValue(Uur & ":" & Minuut)
    [COLOR="#FF0000"]End If[/COLOR]
  End If
End Sub

Rebmog

 

[marco001]

Werkt perfect! Heel erg bedankt.