Saat formatı hk..

[Özgür DALDABAN]

Selamun Aleyküm arkadaşlar
A ve B sütununun herhangi bir hücresine örn.0205 yazdığımda kendisi saat formatına çevirip 02:05 yazmasını istiyorum.
Ayrıca 2400 yazdığımda da 24:00 olarak göstermesini istiyorum.Yardımcı olur musunuz?
Teşekkürler..

 

[YUSUF44]

Hücre biçimlendirmeden özel sayı biçimi olarak 00":"00 ayarlayın. (veri girerken 0205 yazmanıza gerek yok, 205 yazmanız yeterli, yani sol baştaki sıfırları yazmanıza gerek yok)

Ancak unutmayın, bu sadece görünürde 02:05 olacaktır; excel işlemlerde 205 olarak değerlendirir.

 

[Özgür DALDABAN]

Peki excel işlemlerinde de saat olarak değerlendirilmesini istiyorum bunun için bir kod oluşturulabilirmi ?

 

[Necdet]

Merhaba,

A ve B sütunlarını saat olarak biçimlendirin ve aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
    If IsNumeric(Target.Value) = False Or Len(Target.Value) > 4 Then Exit Sub
    
    Application.EnableEvents = False
        If Len(Target.Value) < 3 Then
            Target.Value = TimeSerial(0, Target.Value, 0)
        Else
            Target.Value = TimeSerial(Int(Target.Value / 100), Target.Value Mod 100, 0)
        End If
    Application.EnableEvents = True
    
End Sub

 

[Özgür DALDABAN]

Teşekkürler Necdet bey
Bu kod işime yaradı fakat delete yaptığımda hücreye "0" sıfır değeri atıyor acaba boş olabilirmi birde sayfanın birinde daha önceden yazılmış başka bir kod vardı ikisi bir arada hata verdi acaba aynı anda çalıştırılabilirmi ?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, [F:G]) Is Nothing Then Exit Sub
With Target
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
x = (.Value / 10)
Else
x = .Value
End If
Application.EnableEvents = False
.Value = x
Application.EnableEvents = True
End With
End Sub

 

[Necdet]

Merhaba,

İki kodu ayrı ayrı birleştirdim, deneyiniz.

Belki biraz daha kısaltma olabilir.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [A:B, F:G]) Is Nothing Or Target.Row < 2 Then Exit Sub
    If Target.Column < 3 Then
        If IsNumeric(Target.Value) = False Or Len(Target.Value) > 4 Or Target.Value = "" Then Exit Sub
        Application.EnableEvents = False
        If Len(Target.Value) < 3 Then
            Target.Value = TimeSerial(0, Target.Value, 0)
        Else
            Target.Value = TimeSerial(Int(Target.Value / 100), Target.Value Mod 100, 0)
        End If
        Application.EnableEvents = True
    Else
        With Target
            If Not IsEmpty(.Value) And IsNumeric(.Value) Then
                x = (.Value / 10)
            Else
                x = .Value
            End If
            Application.EnableEvents = False
            .Value = x
            Application.EnableEvents = True
        End With
    End If
    
End Sub

 

[Özgür DALDABAN]

Necdet bey
Saat kısmı fonksiyonu çalışmıyor.