vlugge datum

[Spiesse]

hey guys,

weet er iemand een korte macro om van 1806 18/06/2012 te maken?
De bedoeling is dus van een duizendtal een datumnotatie te maken...

dit is een deel van een macro die van 1000 10:00 maakt in de uurnotatie...

If Intersect(Target, Range("i16943:j500000")) Is Nothing Then GoTo Einde
If IsEmpty(Target) Then GoTo Einde

If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Application.EnableEvents = True
hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
Einde:
ActiveCell.Calculate

zou nie direct weten hoe deze aan te passen aan datumnotatie

nb: de datum staat in kolom H

thx en groeten,

spiesse

 

[wampier]

Je kunt eenvoudig de ingebouwde functies gebruiken:

    invoer = Range("h2").Value
    invoer = Left(invoer, 2) & "/" & Right(invoer, 2)
    MsgBox (Format(invoer, "dd/mm/yyyy"))

Zet je eigen code ook gaarne tussen code tags, dat maakt het wel zo prettig om te lezen. Deze code doet een voorbeeld van alleen H2, maar is natuurlijk prima toe te passen op je bestaande lus.

 

[Spiesse]

Hmhm, something's wrong...

If Intersect(Target, Range("i16943:j500000")) Is Nothing Then GoTo Einde
If IsEmpty(Target) Then GoTo Einde

If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Application.EnableEvents = True
hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")

invoer = Range("H27989:H500000").Value
    invoer = Left(invoer, 2) & "/" & Right(invoer, 2)
Einde:
ActiveCell.Calculate

heb de lijn met msgbox weggelaten want er moet geen msgbox tevoorschijn komen...
de invoer 1605 geeft 23/05/1904 als datumnotatie...

hullup

 

[Niels28]

zo iets

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Target.NumberFormat = "General"
Application.EnableEvents = False
Target.Value = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
Application.EnableEvents = True
End If
End Sub

Niels

 

[wampier]

eh, je moet de in plaats van de msgbox output natuurlijk wel wegschrijven in de cell anders heeft het geen zin

Overigens wordt de code nu nooit uitgevoerd: "H" valt namelijk niet in de intersect "i16943:j500000". Wat er nu gebeurt is dat de formatering van de cell op "datum" staat en excel 1605 converteert naar datum zonder tussenkomst van het script.

 

[Spiesse]

eh, je moet de in plaats van de msgbox output natuurlijk wel wegschrijven in de cell anders heeft het geen zin

Overigens wordt de code nu nooit uitgevoerd: "H" valt namelijk niet in de intersect "i16943:j500000". Wat er nu gebeurt is dat de formatering van de cell op "datum" staat en excel 1605 converteert naar datum zonder tussenkomst van het script.

hoe zou ik dit dan kunnen bekomen???

 

[Niels28]

nog niet...

?????

Niels

 

[Spiesse]

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select

'uren omzetten
If Intersect(Target, Range("i16943:j500000")) Is Nothing Then GoTo Einde
If IsEmpty(Target) Then GoTo Einde

If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Application.EnableEvents = True
hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")

If Not Intersect(Target, Range("H:H")) Is Nothing Then
Target.NumberFormat = "General"
Application.EnableEvents = False
Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
Application.EnableEvents = True
End If

Einde:
ActiveCell.Calculate

End Sub

niels, dit is mijn volledige macro... waar moet ik jou deel invoegen?

 

[Niels28]

Ipv goto gebruiken kun je het argument ook omdraaien dan loopt de macro tenmiste door als het niet aan de voorwaarde voldoet.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
        'uren omzetten
If Not Intersect(Target, Range("i16943:j500000")) Is Nothing Then
    If Not IsEmpty(Target) Then
    
    If Hour(Target.Value) = 0 Or Minute(Target.Value) = 0 Then
        Application.EnableEvents = False
            If Int(Target.Value / 100) < 0.1 Then
                Target = "00:" & Target.Value
                Else
                Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
            End If
        Application.EnableEvents = True
        hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
        If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
        End If
    End If
End If
If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    Application.EnableEvents = True
End If

ActiveCell.Calculate

End Sub

Niels

 

[Spiesse]

that's it!!!!!!!
super!!!
bedankt!!!