Butonla tarih atmayı engelleme

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba.

Ekte gönderdiğim excel dosyamda hareketli buton mevcut, bu butona bastığımda N sütunundaki aktif hücreye tarih atıyor.
Kod gayet güzel çalışıyor, çokta memnunum.

Benim yapmak istediğim L sütunundaki hücre içerisinde geçti yazıyorsa N sütunundaki aktif hücreye tarih atmasını engellemek istiyorum.
L sütununda hücre içerisinde geçti yazanların karşısı olan N sütununa yanlışlıkla butonla tarih atınca toplamlarda yanlış çıkıyor.

Aşağıdaki kod arasına birşeyler eklemeye çalıştım ama yapamadım.

Sub ArşivTarihAt()
If IsDate(ActiveCell.Text) Or ActiveCell.Column <> 14 Then Exit Sub
If ActiveCell.Column = 14 Then Cells(ActiveCell.Row, 14) = Date
End Sub


Yardımcı olur musunuz?
 

Ekli dosyalar

Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Arkadaşlar aşağıdaki gibi yapıyorum yine tarih atıyor. Bir türlü olmadı.

If IsDate(ActiveCell.Text) Or Column = 12 And ActiveCell = "* geçti.)" Or ActiveCell.Column <> 14 Then Exit Sub
 
Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Kodunuzu aşağıdaki şekilde değiştiriniz.
Kod:
Sub ArşivTarihAt()
a = ActiveCell.Row
If IsDate(ActiveCell.Text) Or Len(WorksheetFunction.Substitute(Range("L" & a), "geçti", "")) <> Len(Range("L" & a)) Then
MsgBox " İzini bitenlere tarih atamıyoruz maalesef. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If ActiveCell.Column = 14 Then Cells(ActiveCell.Row, 14) = Date
End Sub
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın çıtır Bey, valla süpersiniz, ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Aşağıdaki mesajı da verdirisek çok süper olacak.

İzni bitenlere tarih atamıyoruz maalesef mesajını verdirmek istedim ama bir türlü ekleyemedim.

Bu konuda da yardımcı olur musunuz?
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Alternatif olsun.

Kod:
Sub ArşivTarihAt()
    If IsDate(ActiveCell.Text) Or ActiveCell.Column <> 14 Then Exit Sub
    Dim Bul
    On Error Resume Next
    Bul = WorksheetFunction.Search("Geçti", ActiveCell.Offset(0, -2).Text)
    If Err.Number <> 0 Then
        Cells(ActiveCell.Row, 14) = Date
    Else
        MsgBox "İzni bitenlere tarih atamıyoruz maalesef."
    End If
End Sub
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın dalgalikur ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Alternatif olması açısından sayın çıtır bey'in göndermiş olduğu kod içerisine mesajı nereye eklemem gerekiyor, yapmaya çalıştım hep hata verdi.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın çıtır Bey ve sayın Dalgalikur ellerinize sağlık, çok teşekkür ediyorum Allah razı olsun.

Hayırlı günler, hayırlı çalışmalar diliyorum.
 
Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Sayın çıtır Bey ve sayın Dalgalikur ellerinize sağlık, çok teşekkür ediyorum Allah razı olsun.

Hayırlı günler, hayırlı çalışmalar diliyorum.
Rica ederim.Dönüş yaptığınız için teşekkür ederim.Hayırlı günler.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın Çıtır Bey, hayırlı geceler.

3.mesajınızdaki kodlar çok işime yarıyor, ellerinize sağlık, bu kod içerisine Eğer L sütununda da bilgi yoksa kod çalışmasını istemiyorum, bunu nasıl ekleriz, eklemeye çalıştım bir türlü başarılı olamadım.

Rich (BB code):
Sub ArşivTarihAt()
a = ActiveCell.Row
If IsDate(ActiveCell.Text) _
Or Len(WorksheetFunction.Substitute(Range("L" & a), "geçti", "")) <> Len(Range("L" & a)) _
Or Len(WorksheetFunction.Substitute(Range("L" & a), "kaldı", "")) <> Len(Range("L" & a)) _
Or Len(WorksheetFunction.Substitute(Range("L" & a), "dönüş bugün", "")) <> Len(Range("L" & a)) _
Or Len(WorksheetFunction.Substitute(Range("L" & a), "", "")) <> Len(Range("L" & a))Then
'MsgBox " İzini bitenlere tarih atamıyoruz maalesef. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If ActiveCell.Column = 14 Then Cells(ActiveCell.Row, 14) = Date
End Sub
Yukarıdaki gibi renkli yeri de ekledim, L sütunundaki hücreler boşsa kod yine çalışıyor, ben çalışmasını istemiyorum.

Birde mesaj içerisine,
eğer L sütunundaki aktif hücre içerisinde geçti yazıyorsa, N sütunudaki aktif hücreye günü geçmiş olanlara tarih atamıyoruz.
eğer L sütunundaki aktif hücre içerisinde kaldı yazıyorsa, N sütunudaki aktif hücreye, izne başlamamış olanlara tarih atamıyoruz.
eğer L sütunundaki aktif hücre içerisinde dönüş bugün yazıyorsa, N sütunudaki aktif hücreye, izinden dönüldüğü için tarih atamıyoruz.
eğer L sütunundaki aktif hücre içerisi boş ise, N sütunudaki aktif hücreye, izin dönüş tarihi boş. şeklinde mesaj verdirebilir misiniz?

Yardımcı olur musunuz?
 
Son düzenleme:
Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Deneyiniz.
Kod:
Sub ArşivTarihAt()
a = ActiveCell.Row
If IsDate(ActiveCell.Text) Or Len(WorksheetFunction.Substitute(Range("L" & a), "geçti", "")) <> Len(Range("L" & a)) Then
Range("N" & a) = "İzini bitenlere tarih atamıyoruz maalesef"
MsgBox " İzini bitenlere tarih atamıyoruz maalesef. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If IsDate(ActiveCell.Text) Or Len(WorksheetFunction.Substitute(Range("L" & a), "kaldı", "")) <> Len(Range("L" & a)) Then
Range("N" & a) = "izne başlamamış olanlara tarih atamıyoruz."
MsgBox "  izne başlamamış olanlara tarih atamıyoruz. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If IsDate(ActiveCell.Text) Or Len(WorksheetFunction.Substitute(Range("L" & a), "dönüş bugün", "")) <> Len(Range("L" & a)) Then
Range("N" & a) = "izinden dönüldüğü için tarih atamıyoruz."
MsgBox "  izinden dönüldüğü için tarih atamıyoruz. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If Range("L" & a) = "" Then
Range("N" & a) = "İzin dönüş tarihi boş"
MsgBox "  izin dönüş tarihi boş olanlara tarih  atamıyoruz. ", vbInformation, "BİLGİNİZE"
Exit Sub
End If
If ActiveCell.Column = 14 Then Cells(ActiveCell.Row, 14) = Date
End Sub
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın çıtır Bey, Allah razı olsun, ellerinize sağlık, çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Hayırlı günler diliyorum.
 
Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Sayın çıtır Bey, Allah razı olsun, ellerinize sağlık, çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Hayırlı günler diliyorum.
Dönüş yaptığınız için teşekkür ederim.Hayırlı günler.
 
Üst