Code om 123456 te veranderen in 12:45:56 (makkelijk tijden invoeren)

[Visara]

Hallo,

Het doel van mijn vraag is de gebruiker snel tijden in te laten voeren. De code moet de invoer veranderen in de cel.
Ik heb een werkende code die de invoer van een gebruiker aanpast. Vult de gebruiker "1234" in, dan veranderd de code dat in "12:34"
Ik wil graag de code aanpassen zodat de invoer 123456 veranderd wordt in 12:34:56

Voorbeelden van invoer en gewenst resultaat:
123456 geeft: 12:34:56
2 geeft: 00:00:02
231000 geeft: 23:10:00
43010 geeft: 04:30:10
0 geeft: 00:00:00
als de gebruiker een veld leeg laat of leeg maakt moet er niet 00:00:00 komen te staan. Het moet dan leeg blijven.

Private Sub Worksheet_Change(ByVal target As Range)
  If Not Intersect(target, Range("A1:A10")) Is Nothing And Not IsEmpty(target) And target.Cells.Count = 1 Then
    Application.EnableEvents = False
    target = Replace(Format(target / 100, "00.00"), ",", ":")
    Application.EnableEvents = True
  End If
End Sub

Het gaat natuurlijk om deze regel:

target = Replace(Format(target / 100, "00.00"), ",", ":")

Ik heb wat pogingen gedaan als "/ 10000", een extra ":", en "00.00.00" maar ik weet gewoon niet zo goed wat hier nou staat en het lukt me daarom niet het met gewenst resultaat aan te passen.

Mvg

 

[SjonR]

zo? Celeigenschappen op "Tijd" zetten.

target = Format(target, "00:00:00")

Maar dan kan je er nog steeds niet mee rekenen.

 

[OctaFish]

waarom zou je daardoor er niet mee kunnen rekenen, het zijn toch netjes tijden geworden ?

Dat je iets ziet als tijd, wil nog niet zeggen dat het ook een tijd is. Elke groep van 2 cijfers die groter is dan 60 (voor minuten en seconden) maakt de waarde geen valide tijd meer. Kijk maar naar het verschil tussen 15653 en 17897. De ene wordt netjes naar een tijd omgezet, de ander alleen als tijd weergegeven. Je kunt elk getal natuurlijk wel omrekenen naar een valide tijd; dan zie je als resultaat natuurlijk niet meer wat je hebt ingegeven.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i1 As Integer, i2 As Integer, i3 As Integer
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A1:A10")) Is Nothing And Not IsEmpty(Target) And Target.Cells.Count = 1 Then
        Select Case Target.Value
            Case 1 To 99
                Target = TimeSerial(0, 0, Target)
            Case 100 To 9999
                Target = TimeSerial(0, Left(Target, Len(Target) - 2), Right(Target, 2))
            Case 10000 To 999999
                i1 = Left(Target, Len(Target) - 4)
                i2 = Mid(Target, 2 + IIf(Len(Target) = 5, 0, 1), 2)
                i3 = Right(Target, 2)
                Target = TimeSerial(i1, i2, i3)
            Case Else
                MsgBox Target.Value
                Target = Null
        End Select
    End If
    Application.EnableEvents = True
End Sub

 

[JeanPaul28]

Dit word ook militaire notatie genoemd, hier nog een voorbeeld

 

[Visara]

Dankjewel JeanPaul28, je voorbeeld werkt zoals ik wil. Super!

Er verschijnt een handige popup wanneer de gebruiker waarden groter dan 59 invult bij de minuten of seconden. Heel handig
Die foutmelding verschijnt echter ook als de gebruiker een veld wist met delete. Dan is die foutmelding natuurlijk een beetje raar.

Ik heb de volgende regel toegevoegd om dat op te lossen en het werkt nu fijn

If Target.Value = 0 Then Exit Sub

If Mid(xWord, 3, 2) > 59 Or Right(xWord, 2) > 59 Then MsgBox "Minuten of sec zijn groter dan 59": Exit Sub

Hoe kan ik meer effecten toevoegen? Het is wel mooi als niet alleen de MsgBox verschijnt, maar dat ook de zojuist ingetypte getallen worden gewist en dat de cel waar de gebruiker mee bezig is wordt geselecteerd (heeft de gebruiker een herkansing om het in te voeren)

Ik probeer zonder gewenst resultaat:

If Mid(xWord, 3, 2) > 59 Or Right(xWord, 2) > 59 Then [SIZE=4][B]Target.ClearContents And Target.Select And[/B][/SIZE] MsgBox "Minuten of sec zijn groter dan 59": Exit Sub

Kan ik effecten opsommen op deze manier? Ik probeer 'And' , meerdere keren 'Then', '&', ',' en nou weet ik het niet meer

 

[JeanPaul28]

Test deze macro eens of die aan u eisen voldoet

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
Dim xHour As String
Dim xMinute As String
Dim xSec As String
Dim xWord As String
xWord = Format(Target.Value, "000000")
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
If Mid(xWord, 3, 2) > 59 And Mid(xWord, 3, 2) > 59 Then Target.Select: Target = Mid(xWord, 1, 2) & "xx" & "xx": MsgBox "Minuten en seconden zijn groter dan 59, wijzig de xx": GoTo Gedaan
If Mid(xWord, 3, 2) > 59 Then Target.Select: Target = Mid(xWord, 1, 2) & "xx" & Mid(xWord, 5, 2): MsgBox "Minuten  zijn groter dan 59, wijzig de xx": GoTo Gedaan
If Right(xWord, 2) > 59 Then Target.Select: Target = Mid(xWord, 1, 2) & Mid(xWord, 3, 2) & "xx": MsgBox "Seconden  zijn groter dan 59, wijzig de xx": GoTo Gedaan

xHour = Left(xWord, 2)
xMinute = Mid(xWord, 3, 2)
xSec = Right(xWord, 2)

Target.Value = TimeValue(xHour & ":" & xMinute & ":" & xSec)
Gedaan:
Application.EnableEvents = True
End Sub

 

[Visara]

Dat werkt prachtig, hartstikke mooi

Mijn dank is groot.

 

[JeanPaul28]

:thumb:

 

[snb]

Sub M_snb()
   On Error Resume Next
   y = 224709
   
   c00 = Format(y, "@@:@@:@@")
   If Err.Number <> 0 Then c00 = "geen tijd"
   
   MsgBox c00
End Sub