Hücreye girilen tarih ve saatin saniye kısmını 00 yapma

[işsiz123]

Merhabalar
E:E sütununa girilen tarih ve saatin saniye kısmını 00 otomatik olsun. Örnek olarak E2 hücresine 27.07.2021 11:05:55 girildiğinde ve enter dediğinde 27.07.2021 11:05:00 diye değişsin. Hücre formatı metin olarak ayarlıdır

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz. E1:E1000 aralığını isteğinize göre değiştirebilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E1:E1000]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If IsDate(Target) = False Then Exit Sub
Application.EnableEvents = False
    Target = DateSerial(Year(Target), Month(Target), Day(Target)) + TimeSerial(Hour(Target), Minute(Target), 0)
Application.EnableEvents = True
End Sub

 

[işsiz123]

Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz. E1:E1000 aralığını isteğinize göre değiştirebilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E1:E1000]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If IsDate(Target) = False Then Exit Sub
Application.EnableEvents = False
    Target = DateSerial(Year(Target), Month(Target), Day(Target)) + TimeSerial(Hour(Target), Minute(Target), 0)
Application.EnableEvents = True
End Sub

Teşekkürler denerim

 

[Korhan Ayhan]

Alternatif;

Çoklu veri girişlerinde sorun çıkarmadan çalışır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Hucre As Range
    
    On Error GoTo Son
    
    Set Alan = Intersect(Target, Range("E:E"))
    
    For Each Hucre In Alan
        If Not Len(Hucre.Value) = 0 Then
            Application.EnableEvents = False
            Hucre = CDate(Format(Hucre, "dd.mm.yyyy hh:mm"))
        End If
    Next
    
    Alan.NumberFormat = "dd.mm.yyyy hh:mm:ss"

Son:
    Set Alan = Nothing
    Application.EnableEvents = True
End Sub

 

[işsiz123]

Teşekkürler
Böyle bir sıkıntımım oldu tarih ve saat arasına 2 boşluk oluşuyor
Normal hücrede de tarih ve saat formatı yaptığımda aynı boşluk oluyor bunu nasıl tek boşluk olarak ayarlayabilirim.

 

[Korhan Ayhan]

Excelin kendi tarih formatı bu şekilde çift boşluklu çıkıyor. Tek boşluk için ısrarlıysanız hücre biçimini METİN olarak ayarlamak gerekir.

 

[işsiz123]

Excelin kendi tarih formatı bu şekilde çift boşluklu çıkıyor. Tek boşluk için ısrarlıysanız hücre biçimini METİN olarak ayarlamak gerekir.

Anladım tek boşluk için sizin gönderdiğiniz kodda nasıl bir değişiklik yapmak lazım

 

[Korhan Ayhan]

Aslında hücrede tek boşluk görünüyor. Sadece formül çubuğunda çift boşluk olarak görünmektedir. En azından ben de o şekilde görünüyor.




Eğer her yerde tek boşluklu format olsun derseniz kodu aşağıdaki gibi revize etmelisiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Hucre As Range
    
    On Error GoTo Son
    
    Set Alan = Intersect(Target, Range("E:E"))
    
    For Each Hucre In Alan
        If Not Len(Hucre.Value) = 0 Then
            Application.EnableEvents = False
            Hucre.NumberFormat = "@"
            Hucre = Format(Hucre, "dd.mm.yyyy hh:mm:00")
        End If
    Next
    
Son:
    Set Alan = Nothing
    Application.EnableEvents = True
End Sub

 

[işsiz123]

Aslında hücrede tek boşluk görünüyor. Sadece formül çubuğunda çift boşluk olarak görünmektedir. En azından ben de o şekilde görünüyor.


Ekli dosyayı görüntüle 229077

Eğer her yerde tek boşluklu format olsun derseniz kodu aşağıdaki gibi revize etmelisiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Hucre As Range
   
    On Error GoTo Son
   
    Set Alan = Intersect(Target, Range("E:E"))
   
    For Each Hucre In Alan
        If Not Len(Hucre.Value) = 0 Then
            Application.EnableEvents = False
            Hucre.NumberFormat = "@"
            Hucre = Format(Hucre, "dd.mm.yyyy hh:mm:00")
        End If
    Next
   
Son:
    Set Alan = Nothing
    Application.EnableEvents = True
End Sub

Teşekkürler

 

[işsiz123]

Aslında hücrede tek boşluk görünüyor. Sadece formül çubuğunda çift boşluk olarak görünmektedir. En azından ben de o şekilde görünüyor.


Ekli dosyayı görüntüle 229077

Eğer her yerde tek boşluklu format olsun derseniz kodu aşağıdaki gibi revize etmelisiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Hucre As Range
   
    On Error GoTo Son
   
    Set Alan = Intersect(Target, Range("E:E"))
   
    For Each Hucre In Alan
        If Not Len(Hucre.Value) = 0 Then
            Application.EnableEvents = False
            Hucre.NumberFormat = "@"
            Hucre = Format(Hucre, "dd.mm.yyyy hh:mm:00")
        End If
    Next
   
Son:
    Set Alan = Nothing
    Application.EnableEvents = True
End Sub

Sayın Korhan Ayhan
Öncelikle Teşekkürler

Başka bir sorum olacak mesala E:E satırında sadece 5 tane eşit veri olsun. 5ten fazla ise otomatik olarak 1 dakika sonrasına aktarsın.

Örnek olarak

27.07.2021 11:05:00
27.07.2021 11:05:00
27.07.2021 11:05:00
27.07.2021 11:05:00
27.07.2021 11:05:00
27.07.2021 11:05:00 5 adet aynı veri olduğu için bu hücredekidakikayı 1 arttırsın 27.07.2021 11:06:00 gibi