Opgelost verkort tijd invoeren macro

[dirkc]

Ik gebruik een macro om snel uren in te vullen.
Zo moet ik voor '13:00' gewoon 1300 intikken in bereik c4 f60
Dit werkt perfect maar als ik 3600 (36uur) intik verrekent die dat volgens 24u stelsel.

De celeigenschappen staan op 'tijd 13.30'​

Als ik dit wijzig naar aangepaste instellingen bv:mm heeft dit ook geen invloed


Wat kan ik aanpassen in deze macro of welke kan ik daarvoor gebruiken ?
Met de invoer wordt verder ook nog een berekening gemaakt (werkt met deze macr zolang ik onder de 24u blijf)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c4:f60")) Is Nothing Then
If Target.Cells.Count = 1 Then
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)
End If

End If
End Sub

Alvast bedankt

 

[peter59]

Ik weet niet of het iets uithaalt maar niet geschoten is altijd mis.
Zet de aangepaste celeigenschappen eens op [uu]:mm

 

[dirkc]

blijkbaar stukje text weg
Ik had dit al reeds getest en ook op elke uurnotatie...geen invloed
Werkmap staat ook op de 1904 tijdsnotatie bij de opties. ook dit heeft geen invloed

Ik zie wel in de macro "uur= uur mod24" logisch dat deze dus met 24-uren stelsel werkt, maar weet dus niet hoe ik het moet veranderen zodat de invoer 3600 gewoon naar 36:00 verandert

Alvast bedankt voor je reactie

 

[peter59]

Probeer deze eens. Anders graag een voorbeeldbestandje.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C4:F60")) Is Nothing Then
        If Target.Cells.Count = 1 Then
            Dim Minuten As Integer
            Minuten = Target Mod 100
            Dim Uren As Integer
            Uren = Int(Target / 100)
            Uren = Uren + Int(Minuten / 60): Minuten = Minuten Mod 60
            If Uren >= 24 Then
                Target = Uren - 24 & ":" & Minuten
            Else
                Target = Uren & ":" & Minuten
            End If
        End If
    End If
End Sub

 

[edmoor]

Is dit misschien voldoende:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C4:F60")) Is Nothing Then Exit Sub
    If Target.Count = 1 Then
        Application.EnableEvents = False
        td = Target.Value
        Target.NumberFormat = "[h]:mm"
        Target = Left(td, 2) & ":" & Right(td, 2)
        Application.EnableEvents = True
    End If
End Sub

 

[HSV]

Of:

Private Sub Worksheet_Change(ByVal Target As Range)
If not Intersect(Target, Range("C4:F60")) Is Nothing then
 If Target.Count = 1 Then
   Application.EnableEvents = False
      Target = Format(Target, "00\:00")
  Application.EnableEvents = True
 end if
End If
End Sub

 

[dirkc]

Bedankt voor jullie hulp)

Ik heb even zitten testen :
macro peter werkt niet : geeft fout
macro edoor geeft volgende :

invoer 130	13:30​
invoer 1330	13:30​
invoer 3600	36:00​
invoer 360	36:60

ik kan dus 1u30 niet invoeren of werken met een invoer var slechts 3 getallen dus alles beneden 10u(invoer1000) is onmogelijk


macro hsv is perfect )
Enige probleem is dat de macro "360" schrijft als 4:00 maar dit is een logisch resultaat (3u+60m = 4u)
Dit verstoort de werking van mijn file zeker niet gezien de ingave groter moet zijn dan 8u in die kolom en ik dit kan oplossen door een
popup-melding als de ingave lager is.

Voor de rest heeft de oplossing me zeker verder geholpen.
Dank voor jullie tijd )

 

[popipipo]

Ik gebruik een macro om snel uren in te vullen.

Door gebruik te maken van de autocorrectie van excel kun je ook snel tijd invoeren
Laat ++ door excel omzetten naar : en in een oogwenk heb je de tijd in het gewenst formaat ingevoerd.
Een maal ingevoerd werkt het altijd ook bij WORD of POWERPOINT

 

[dirkc]

Werkt inderdaad ook perfect -) met celeigenschappen naar :mm hetzelfde resultaat.
Hopelijk moet ik nu nooit iets schrijven waarin '++' moet blijven staan )
Bedankt voor de reactie

 

[HSV]

Hahaha, is mogelijk met HR++ glas.

 

[snb]

Ik heb er nog eentje voor je:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   Target = (Target \ 100) / 24 + (Target Mod 100) / 1440
   Application.EnableEvents = True
End Sub

Zo wordt ook de invoer van bijv. 173 goed verwerkt.

 

[popipipo]

Hahaha, is mogelijk met HR++ glas.

je kunt natuurlijk ook -- ipv ++ om laten zetten naar :
HR-- glas bestaat nl niet.

 

[snb]

Is slechts een kwestie van tijd.