İki sutundaki aynı satırdaki hücrelerin verilerini kontrol etme

[TASADAM366]

Değerli arkadaşlarım size gönderdiğim örnekte 2 sayfa vardır.İkiside şekil itibarıyla aynıdır.Her iki sayfanın C sutunlarındaki bilgilern yazı rengi beyaz seçilerek gizlenmiştir.
Şimdi istediğim şu,diyelimki örnekteki EAK sayfasında D3 hücresine TATLI yazdım .Doğrula butonuna tıkladığımda,makro C3 hücresini kontrol edip eğer TATLI yazıyorsa CEVABINIZ DOĞRUDUR TEBRİK EDERİZ. yazısı olan küçük bir pencere açılsın.2-3 saniye durup kapansın.Eğer D3 hücresine yazılan C3 hücresindekiyle aynı değilse bir uyarı penceresi açılsın ve ÜZGÜNÜM CEVABINIZ DOĞRU DEĞİL.İYİ DÜŞÜNÜN.Yazsın.
Bu makro D250 hücresine kadar aktif olsun.Ve yazılmamış hücreleri kontrol etmesin.
Aktif olan hücreyi(veya satırı) kontrol etsin.
Bu makro her iki sayfada da aynı şekilde işlesin.
İlginiz ve yardımlarınız içinşimdiden teşekkür ederim.
Not:Makrolu çözüm istiyorum acizane...Saygılarımla

 

[lazr55]

böyle bir çalışma vardı sanki..

 

[Mustafa MUTLU]

İlgili Sayfanın Kod Bölümüne

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D: D")) Is Nothing Then Exit Sub
If Target = Target.Previous Then
MsgBox "CEVABINIZ DOĞRUDUR TEBRİK EDERİZ.", vbInformation, "Mustafa MUTLU 0 533 740 45 49"
Else
MsgBox " ÜZGÜNÜM CEVABINIZ DOĞRU DEĞİL.İYİ DÜŞÜNÜN.", vbInformation, "Mustafa MUTLU 0 533 740 45 49"
End If
End Sub

Yazınız.
MsgBox ile Cevap verdim
Buda İşinizi görür sanırım..

If Intersect(Target, Range("D: D")) Is Nothing Then Exit Sub
Buradaki D den önceki boşluğu siliniz..

 

[TASADAM366]

Sayın Mustafa MUTLU verdiğiniz kod fazlasıyla işimi görür.Ufak bir sorun var.O da şu.
D sutununa girilmiş metinleri seçip silmek için Del tuşuna basınca şu hatayı veriyor.(Hataya rağmen sorunsuz çalışıyor.)
Run-type error 13:
Type mismatch

Saygılarımla

 

[Mustafa MUTLU]

Sayın Mustafa MUTLU verdiğiniz kod fazlasıyla işimi görür.Ufak bir sorun var.O da şu.
D sutununa girilmiş metinleri seçip silmek için Del tuşuna basınca şu hatayı veriyor.(Hataya rağmen sorunsuz çalışıyor.)
Run-type error 13:
Type mismatch

Saygılarımla

Koda Kırmızı renli satırları ekleyiniz,

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Gel
If Intersect(Target, Range("D")) Is Nothing Then Exit Sub
If Target = Target.Previous Then
MsgBox "CEVABINIZ DOĞRUDUR TEBRİK EDERİZ.", vbInformation, "Mustafa MUTLU 0 533 740 45 49"
Else
MsgBox " ÜZGÜNÜM CEVABINIZ DOĞRU DEĞİL.İYİ DÜŞÜNÜN.", vbInformation, "Mustafa MUTLU 0 533 740 45 49"
End If
Gel:
End Sub