Tarihleri biçimlendirmesi hk.

[1903emre34@gmail.com]

Merhaba,

"B" sütüna 01 2020 veya 12 2020 yazdığımız zaman, 01-2020/01-2020 veya 12-2020/12-2020 gelecek şekilde

 

[Ömer]

Merhaba,

Sayfanın kod bölümüne:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bicim, s As String, t As Byte
    If Intersect(Target, Range("B:B,D:D")) Is Nothing Then Exit Sub
    With Target
        If .Row < 2 Then Exit Sub
        If .Count > 1 Then Exit Sub
        If .Column = 4 Then
            Cells(.Row, "F").NumberFormat = "General"
            Cells(.Row, "G").NumberFormat = "General"
            bicim = "00-00-0000"
            If Len(.Value) < 5 Then bicim = "00-00"
            If Len(.Value) < 7 And Len(.Value) > 4 Then bicim = "00-00-00"
            If IsDate(Format(.Value, bicim)) = True Then
                Application.EnableEvents = False
                Cells(.Row, "F") = CDate(Format(.Value, bicim))
                Cells(.Row, "G") = CDate(Format(.Value, bicim))
                Application.EnableEvents = True
            End If
        End If
        If .Column = 2 Then
            t = InStr(.Value, "/")
            If t = 0 Then
                s = Replace(.Value, " ", "-")
                .Value = s & "/" & s
            End If
        End If
    End With
End Sub

 

[1903emre34@gmail.com]

İlginiz için, "D" sütüna tarih yazdığım zaman tarihleri aralarında "-" işareti olmadı,

 

[Ömer]

Kodlardaki;

Cells(.Row, "F") = CDate(Format(.Value, bicim))
Cells(.Row, "G") = CDate(Format(.Value, bicim))

CDate leri silip deneyiniz. Aşağıdaki gibi.

Cells(.Row, "F") = Format(.Value, bicim)
Cells(.Row, "G") = Format(.Value, bicim)

 

[1903emre34@gmail.com]

Kodlarda değişiklik yaptım ama olmadı , D sütüna 05122020 yazdığım zaman F ve G sütünlarda 12.05.2020 yazıyor.

 

[Ömer]

Deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bicim, s As String, t As Byte
    If Intersect(Target, Range("B:B,D:D")) Is Nothing Then Exit Sub
    With Target
        If .Row < 2 Then Exit Sub
        If .Count > 1 Then Exit Sub
        If .Column = 4 Then
            Cells(.Row, "F").NumberFormat = "@"
            Cells(.Row, "G").NumberFormat = "@"
            bicim = "00-00-0000"
            If Len(.Value) < 5 Then bicim = "00-00"
            If Len(.Value) < 7 And Len(.Value) > 4 Then bicim = "00-00-00"
            If IsDate(Format(.Value, bicim)) = True Then
                Application.EnableEvents = False
                Cells(.Row, "F") = Format(.Value, bicim)
                Cells(.Row, "G") = Format(.Value, bicim)
                Application.EnableEvents = True
            End If
        End If
        If .Column = 2 Then
            t = InStr(.Value, "/")
            If t = 0 Then
                s = Replace(.Value, " ", "-")
                .Value = s & "/" & s
            End If
        End If
    End With
End Sub

 

[1903emre34@gmail.com]

F ve G sütünlardaki tarihler aralarında "-" işareti oluyor, "D" sütünda yer alan tarihin aralarında "-" işareti olması için kodlarda değişiklik yaparbilir miyiz

 

[Ömer]

Deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bicim, s As String, t As Byte
    If Intersect(Target, Range("B:B,D:D")) Is Nothing Then Exit Sub
    With Target
        If .Row < 2 Then Exit Sub
        If .Count > 1 Then Exit Sub
        If .Column = 4 Then
            Cells(.Row, "F").NumberFormat = "@"
            Cells(.Row, "G").NumberFormat = "@"
            bicim = "00-00-0000"
            If Len(.Value) < 5 Then bicim = "00-00"
            If Len(.Value) < 7 And Len(.Value) > 4 Then bicim = "00-00-00"
            If IsDate(Format(.Value, bicim)) = True Then
                Application.EnableEvents = False
                Cells(.Row, "F") = Format(.Value, bicim)
                Cells(.Row, "G") = Format(.Value, bicim)
                Cells(.Row, "D") = Format(.Value, bicim)
                Application.EnableEvents = True
            End If
        End If
        If .Column = 2 Then
            t = InStr(.Value, "/")
            If t = 0 Then
                s = Replace(.Value, " ", "-")
                .Value = s & "/" & s
            End If
        End If
    End With
End Sub