• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Yaş hesabı makrosunu düzenleme

ASLAN7410

ASLAN7410

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba arkadaşlar herkese hayırlı ramazanlar.

Ekte gönderdiğim kodu ve formülü kendi sayfamda kullanıyorum ancak küçük bir sorun var, H12 hücresine içerisinde bulunduğum günden yukarı bir tarih yazıp enter ile çıktığımda ekrana V12 hücresindeki yazı ile birlikte Şahıs 18 yaşından küçük şeklinde hatalı bir mesaj geliyor, sadece V12 hücresindeki yazı gelse yeterli olacak, bunu düzeltemedim.

Hatalı mesajı sayfaya yapıştırdım.

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

http://s2.dosya.tc/server2/yfta75/Ornek.rar.html
 

Ekli dosyalar

Son düzenleme:
Merhaba.

Kod'u aşağıdaki gibi değiştirince istediğiniz gibi oluyor sanırım.
.
Kod: 
[FONT="Arial Narrow"][COLOR="blue"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B][/COLOR]
If Intersect(Target, [H12]) Is Nothing Then Exit Sub
    Call Tarih_Farkı
[COLOR="blue"][B]End Sub[/B][/COLOR]

[B][COLOR="blue"]Sub Tarih_Farkı()[/COLOR][/B]
If Date < [H12] Then
    [H12].Activate
    MsgBox "Bugünden sonraki bir tarih yazdınız," & vbLf & _
            "Tarihi kontrol ederek yeniden yazınız.", vbInformation, "ASLAN"
    Exit Sub
Else
    Yıl = DateDiff("yyyy", [H12], Date)
    Ay = DateDiff("m", [H12], Date) + (Day([H12]) > Day(Date))
 
    Yıl = DateDiff("yyyy", [H12], Date) + ((Ay - Yıl * 12) < 0)
    Ay = Ay Mod 12
    Gün = DateDiff("d", [H12], Date) - DateDiff("d", [H12], _
    DateAdd("yyyy", Yıl, DateAdd("m", Ay, [H12])))

    If Yıl < 18 Then
        [H12].Activate
        MsgBox "Şahıs 18 yaşından küçük." & vbLf & _
        "( " & Yıl & " yıl, " & Ay & " ay, " & Gün & " gün )", vbInformation, "ASLAN"
        Exit Sub
    Else
        [H12].Activate
        MsgBox "Şahıs 18 yaşından büyük." & vbLf & _
        "( " & Yıl & " yıl, " & Ay & " ay, " & Gün & " gün )", vbInformation, "ASLAN"
        Exit Sub
    End If
End If
[B][COLOR="Blue"]End Sub[/COLOR][/B][/FONT]
 
Son düzenleme:
Sayın Ömer Bey ilginize ve emeğinize çok teşekkür ediyorum, hayırlı Ramazanlar.

Gönderdiğim örneğe sizin düzenlemiş olduğunuz kodları uyguladığımda örnekte bulunan 26.06.2016 tarihinde herhangi bir sorun çıkarmıyor, içinde bulunan tarihten farklı olarak gün ve ayı fazla yazdığımda sorun çıkarmıyor, ancak yılı fazla yazdığımda aynı hatayı alıyorum.

Örneğin 26.06.2017-29.10.2018 gibi yazdığımda aynı hatayı veriyor.
 
Merhaba Sayın ERASLAN.

İsteğinizi tam olarak anlayamadım.
-- Hücreye bugünden eski bir tarih de yazılacak mı, bu durumda yapılacak işem nedir?
-- Hücreye bugünden ileri bir tarih yazılacak mı, bu durumda yapılacak işem nedir?
-- Hücreye bugünün tarihi yazıldığında yapılacak işlem nedir?
Her üç seçeneğe göre isteğinizi tam olarak ifade eder misiniz?
.
 
Sayın Ömer Bey yapmak istediğim şahsın bilgilerini yazarken doğum tarihini yazdığım zaman şahsın tam yaşını öğrenmek, şahıs 18 yaşından küçükse ifadesi alınmıyor, kriter 18 yaş.

Şahsın doğum tarihinin yanlış yazılmasını engellemek için bu uyarıları almak istemiştim.
 
Merhaba.

Önceki cevabımdaki kod'u güncelledim, mevcut kodları silip onun yerine yapıştırarak deneyiniz.
Sayfada (V12 hücresi) yer alan formül kullanılmıyor, o formülü de silebilirsiniz.
.
 
Son düzenleme:
Sayın Ömer Bey cevabınız için çok teşekkür ediyorum, yazmış olduğunuz kodlar çok güzel çalışıyor.

Örneğin H12 hücresine 24.06.2016 gibi bir tarih yazdığımda ekrana gelen mesaj kutusunda (0 yıl, 0 ay, 1 gün) şeklinde geliyor, bu mesaj kutusunda 0 olanları göstermese yani 1 gün şeklinde gösterebilir mi?

24.06.2016 gibi tarih yazdığımda 0 yıl, 2 ay, 1 gün şeklinde mesaj kutusu geliyor, burada 0 yıl gelmese sadece 2 ay 1 gün gibi gelse olur mu?

24.05.2016 yazdığımda 1 yıl, 0 ay, 1 gün şeklinde mesaj kutusu geliyor, burada 0 ay gelmese 1 yıl, 1 gün şeklinde gelebilir mi?

V12 hücresindeki formülde bu şekilde gösterdiği için bu formülü tercih etmiştim. Bu formülün vermiş olduğu sonuçlar gibi makro düzenlenebilir mi?
 
Sayın Ömer Bey ellerinize zihninize sağlık tam istediğim gibi olmuş, Allah razı olsun.

Küçük bir sorun gibi gördüğüm bir şey var, bunu istemiş olsam herhalde kodu bozmuş olur muyum bilmiyorum?

H12 hücresine bugünün tarihini yazdığımda ekrana Şahıs 18 yaşından küçük ( ) bu şekilde bir mesaj geliyor, yazılan tarih bugünün tarihi ise bugünün tarihini yazdınız şeklinde uyarı verse olur mu?

Sizi uğraştırdım hakkınızı helal edin. İyi çalışmalar.
 
Merhaba.

Kod'un Sub Tarih_Farkı() kısmını aşağıdaki ile değiştirin.
.
Kod: 
[FONT="Arial Narrow"][B][COLOR="blue"]Sub Tarih_Farkı()[/COLOR][/B]
If Date = [H12] Then
    [H12].Activate: MsgBox "HATA: Bugünün tarihini yazdınız.", vbCritical, "ASLAN": Exit Sub
End If

If Date < [H12] Then
    [H12].Activate: MsgBox "Bugünden sonraki bir tarih yazdınız," & vbLf & _
    "Tarihi kontrol ederek yeniden yazınız.", vbCritical, "ASLAN": Exit Sub
Else
    Yıl = DateDiff("yyyy", [H12], Date)
    Ay = DateDiff("m", [H12], Date) + (Day([H12]) > Day(Date))
 
    Yıl = DateDiff("yyyy", [H12], Date) + ((Ay - Yıl * 12) < 0)
    Ay = Ay Mod 12
    Gün = DateDiff("d", [H12], Date) - DateDiff("d", [H12], _
                DateAdd("yyyy", Yıl, DateAdd("m", Ay, [H12])))
        
        If Yıl = 0 Then
            Yıl = ""
                Else: Yıl = Yıl & " Yıl  "
                    End If
                        If Ay = 0 Then
                            Ay = ""
                            Else: Ay = Ay & " Ay  "
                        End If
                    If Gün = 0 Then
                Gün = ""
            Else: Gün = Gün & " Gün "
        End If

bilgi = Yıl & Ay & Gün
    
    If DateDiff("yyyy", [H12], Date) + ((DateDiff("m", [H12], Date) + (Day([H12]) > Day(Date)) Mod 12 - DateDiff("yyyy", [H12], Date) * 12) < 0) < 18 Then
        [H12].Activate: MsgBox "Şahıs 18 yaşından küçük." & vbLf & _
        "(  " & bilgi & ")", vbCritical, "ASLAN": Exit Sub
    Else
        [H12].Activate: MsgBox "Şahıs 18 yaşından büyük." & vbLf & _
        "(  " & bilgi & ")", vbInformation, "ASLAN": Exit Sub
    End If
End If

[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]
 
Sayın Ömer Bey Allah razı olsun çok teşekkür ediyorum ellerinize sağlık tam istediğim gibi oldu.

Sizi uğraştırdım kusura bakmayın hakkınızı helal edin, hayırlı Ramazanlar hayırlı iftarlar.
 
Sayın Ömer Bey affınıza sığınarak rahatsız ediyorum, küçük bir hata oluştu, kusura bakmayın.

Bu kodu kendi orjinal dosyama uyguladım çok güzel çalışıyor herhangi bir sıkıntı yok, ancak butonla verileri temizle dediğimde tabiki bu hücrede temizlendiği için ekte gönderdiğim mesaj geliyor, hücreyi sildiğimizde herhangi bir mesaj gelmese olur mu?

Kendim yapmaya çalıştım ancak yapamadım.
 

Ekli dosyalar

  • Örnek.jpg
    Örnek.jpg
    27.9 KB · Görüntüleme: 4
Merhaba.

Private Sub Worksheet_Change(ByVal Target As Range) kod kısmında
Call Tarih_Farkı satırının bir üst satırı olarak
aşağıdaki satırı eklemeniz yeterli olur.
.
Kod: 
If Target = "" Then Exit Sub
 
Sayın Ömer Bey dediğiniz yere yapıştırdım ancak hata verdi, siyahla yazılı olan yeri sarıya boyuyor, sayfamdaki kodları gönderiyorum.
Vba kodlarından fazla anlamadığım için yapamadım, aşağıdaki kodları düzenleyebilir misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("H12")) Is Nothing Then
    [B]If Target = "" Then Exit Sub[/B]
    Call Tarih_Farkı
End If

If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
If Target.Address = "$H$6" And Range("H6") <> [W1] Then
    soru1 = MsgBox("TC.No doğru değil. Veri silinecek! . .", vbInformation + vbYesNo, "ASLAN")
    If soru1 = vbYes Then
    Range("H6").ClearContents
    CreateObject("WScript.Shell").Popup "Yanlış yazılmış olan TC.No silindi!..", 1, "A S L A N"
    End If
    
    If soru1 = vbNo Then
    CreateObject("WScript.Shell").Popup "Vazgeçildi.", 1, "A S L A N"
    Range("H6").Select
End If
End If

End Sub
 
Tekrar merhaba.

Uygulanmış hali ekli belgede.

Sanırım asıl belgenizde Worksheet_Change kodu kullanan başka olaylar/başka hedef hücreler de var.
Asıl belgenizin paylaşabileceğiniz bir örneğini hazırlayıp eklerseniz bakarım elbette.
.
 

Ekli dosyalar

Sayın Ömer Bey uzun uğraşlar sonucu sayfayı ayarladım, ekte gönderiyorum.

H6 hücresinde TC kontrolü yapıyordum, aynı sayfanın H12 hücresindede doğum tarihi kontrol ediyordum,
Private Sub Worksheet_Change(ByVal Target As Range) kod başlığında kodlar çakışıp hata veriyor düzeltemedim.
 

Ekli dosyalar

Son düzenleme:
Yeni dosya yüklendi.

Tekrar merhaba.

Eklediğiniz belgede, kod ile formül bir anlamda döngü oluşturuyordu (W1 hücresi)

Ekli belgede hem kod üzerinden TC kimlik numarası kontrolü (formüldeki kontrol) ve hem de
yaş hesabı olayı yeniden düzenlendi.
(Başka şey için gerekli değilse W1 hücresindeki formülü silebilirsiniz)

Her ikisinide kontrol edip, denemeler yapınız.
.
 

Ekli dosyalar

Son düzenleme:
Sayın Ömer Bey kusura bakmayın uğraştırıyorum, göndermiş olduğunuz kodlarda H6 hücresine kendi TC numaramı yazıyorum hatalı diyerek siliyor, ayrıca sayfayı temizle butonuna bastığımda If Target = "" Then Exit Sub bu kodu sarıya boyuyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst