Çözüldü Saat formatı yazımı

[k0081]

Merhaba arkadaşlar;

E3:F78 aralığındaki hücrelere makine çalışma saatlerini yazıyorum

E
başlangıç saati

F
Bitiş saati


yapmak istediğim
---------------------

örnek

başlangıç saati : 13:50 --> bunu 13,50 şeklinde girmek . yazılacak değer yine saat formatında ve 13:50 şeklinde olmalıdır.

bunu nasıl yapabilirim ?

yardımcı arkadaşa şimdiden teşekkürler.

 

[dedenet]

13,50 gireyim ama görüntüsü 13:50 mi olsun diyorsunuz

 

[k0081]

13,50 gireyim ama görüntüsü 13:50 mi olsun diyorsunuz

Evet . biçimde saat olmalı

 

[Haluk]

Sayfa modülüne;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E3:F78")) Is Nothing Then
        If Target Like "#*,##" Then
            h = Split(Target, ",")(0)
            Target = h & ":" & Split(Target, ",")(1)
        End If
    End If
End Sub

.

 

[k0081]

Sayfa modülüne;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E3:F78")) Is Nothing Then
        If Target Like "#*,##" Then
            h = Split(Target, ",")(0)
            Target = h & ":" & Split(Target, ",")(1)
        End If
    End If
End Sub

.

13,50 giriyorum. 12:00 yapıyor hocam

***********************************


13,51 girdiğimde oluyor... 13:51

 

[beab05]

Merhaba;

Alttaki gibi test edebilirsiniz.

Sub SaatDuzelt()
    Dim h As Double
    
    h = ActiveCell.value
    ActiveCell.value = Format(TimeSerial(Int(h), (h - Int(h)) * 100, 0), "hh:mm")
End Sub

 

[k0081]

@beab05

Evet bu düzeltiyor. Ancak bunu giriş esnasında yapmalıyım

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Data As Variant
    
    On Error GoTo 10
    
    If Intersect(Target, Range("E3:F78")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    If IsNumeric(Target) Then
        Data = (Int(Target.Value2) & ":" & Round((Target.Value2 - Int(Target.Value2)) * 100, 0))
        Target = Data
    End If

10  Application.EnableEvents = True
End Sub

 

[k0081]

@Korhan Ayhan

Hocam çok teşekkürler. Tamamdır. Elinize sağlık.