listede yoksa uyarı

[yesilcan]

Arkadaşlar sayfa 2'de a1:a500 arasında bir listem var.sayfa 1'de c5,c7,c9,c11,c13,c15,c17,c19,c21,c23 hücrelerine yazdığım değer sayfa 2 deki a1;a500 arasında yoksa uyarı versin.nasıl yapabilirim.değerli yardımlarınızı bekliyorum.

 

[altanson]

sayfa1 de aşağıdaki formülü dener misiniz?

=EĞER(EHATALIYSA(DÜŞEYARA(C5;sayfa2!$A$1:$A$500;1));"HATA...!!!";"")

 

[yesilcan]

bir daha ilave .ama zor değildir herhalde

sayfa 1 deki c5,c7,c9,c11,c13,c15,c17,c19,c21,c23 hücrelerine aynı değerleri yazdığımda uyarsın.mükerrer kayıt örneklerine baktım ama belli hücreler için mükerrer kayıdı bulamadım.yardımlarınızı rica ediyorum.yani mükerrer kayıdı sadece bu hücreler için geçerli kılacak.şimdiden tşk.ederim

 

[altanson]

bir önceki mesajdaki formülü d5 hücresine yazın. d5 ve d6 hücrelerini birlikte seçip aşağıya doğru uzatın.

 

[yesilcan]

Altanson ArkadaŞim

İlgİn İÇİn Öncelİkle TŞk.ederİm.lÜtfen FormÜlÜn İngİlİzcesİnİ Yollarmisin ?

 

[altanson]

ingilizcesinden emin değilim ama şöyle sanırım;

=IF(ISERROR(VLOOKUP(C5;sayfa2!$A$1:$A$500;1));"HATA...!!!";"")

eğer yanlışsa forumda formüllerin ingilizce - Türkçe karşılıklarını bulabilirsiniz.

 

[yesilcan]

sonsuz teşekkürler ediyorum.

çok teşekkür eder çalışma hayatınızda başarılar dilerim.

 

[yesilcan]

altanson arkadaşım olmadı

dosyamı gönderiyorum.diğer arkadaşların da yardımlarına ihtiyacım var.

 

[altanson]

ilk sorunuzu veri doğrulama ile yapabiliriz fakat ikinci sorunuzdaki "aynı veri girildiğinde uyarı verilmesini" makro ile yapılması gerek onu da ben bilmiyorum maalesef.

 

[yesilcan]

ilgi için teşekkür

arkadaşlar altanson arkadaşım elinden gelini yapmış çok da güzel olmuş fakat 2 sorumun yanıtını alamadım. Forumdaki arkadaşlarımdan yardım talep ediyorum.

 

[Ferhat Pazarçevirdi]

Merhabalar,

Aşağıdaki kodları sheet1'in kod sayfasına kopyalayınız.

NOT : Sn.altanson'un Veri Doğrulama çözümünü de bunun üzerine uygulayabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo f1
If Intersect(Target, [C5], [C7], [C9], [C11], [C13], [C15], [C17], [C19], [C21], [C23]) Is Nothing Then
   If IsEmpty(Target) Then: Exit Sub
   Application.EnableEvents = False
   deger = Target
   Target = Empty
   Set bul = Range("C5:C23").Find(deger, , , xlWhole)
   If Not bul Is Nothing Then
      If bul.Address = Target.Address Then: Exit Sub
      MsgBox "Bu değerden zatn girilmiş", vbCritical, "UYARI"
      Target = Empty
      Target.Select
      Set bul = Nothing
      Application.EnableEvents = True
      Exit Sub
   Else
      Target = deger
      Application.EnableEvents = True
   End If
 
   Set bul = Sheets("Sheet2").Range("A1:A500").Find(Target, , , xlWhole)
   If bul Is Nothing Then
      MsgBox "Bu değer yok", vbCritical, "UYARI"
      Application.EnableEvents = False
      Target = Empty
      Application.EnableEvents = True
      Target.Select
      Set bul = Nothing
      Exit Sub
   End If
End If
f1:
Application.EnableEvents = True
End Sub

 

[yesilcan]

Fpc Hocam İlgİn İÇİn TeŞekkÜr Ama

C6,c8,c10,c12,c14,c16,c18,c20,c22,c24 HÜcrelerİne BaĞimsiz Bİr Verİ GİrİŞİ SaĞlayamiyorum.

Yanİ Renklİ HÜcrelere Sinirli Verİ GİrİŞİ Renklİ HÜcrelerİn Arasindakİ HÜcrelere BaĞimsiz Verİ GİrİŞİ SaĞlamak İstİyorum.sabrin Ve Yardimlarin İÇİn Şİmdİden TeŞekkÜr Ederİm.

 

[Ferhat Pazarçevirdi]

Kendi adıma konuşuyorum : Demek ki n'olacakmış? İşin kolayına kaçılmayacakmış....

Revize edilmiş kodlar aşağıda verilmiştir.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim hucreler()
Dim i%, j%, x%
Dim deger As Variant
Dim Bul As Range
hucreler = Array("$C$5", "$C$7", "$C$9", "$C$11", "$C$13", "$C$15", "$C$17", "$C$19", "$C$21", "$C$23")
For i = 0 To UBound(hucreler) ' - 1
    If Target.Address = hucreler(i) Then
       Application.EnableEvents = False
       deger = Target.Value
       Target = Empty
       For j = 0 To UBound(hucreler) - 1
           If Range(hucreler(j)) = deger Then
              MsgBox "Bu değerden zaten girilmiş", vbCritical, "UYARI"
'              Target = Empty
              Target.Select
              Application.EnableEvents = True
              Exit Sub
           End If
       Next j
       Target = deger
       Application.EnableEvents = True
       x = x + 1
    End If
Next i
If x = 0 Then: Exit Sub
   
Set Bul = Sheets("Sheet2").Range("A1:A500").Find(Target, , , xlWhole)
If Bul Is Nothing Then
   MsgBox "Bu değer yok", vbCritical, "UYARI"
   Application.EnableEvents = False
   Target = Empty
   Application.EnableEvents = True
   Target.Select
   Set Bul = Nothing
   Exit Sub
End If
End Sub

 

[yesilcan]

Fpc Hocam ;

Hocam Çok GÜzel OlmuŞ Tam İstedİĞİm Gİbİ Fakat Dİkkat Edersenİz C25 Ve C25'den Sonrakİ HÜcrelere Verİ GİrdİĞİmde ''deĞer Yok'' Uyarisi Verİyor.bunu DÜzeltİrsek 4*4 Olacak.

Affiniza SiĞiniyor.İyİ ÇaliŞmalar Dİlİyorum.

 

[Ferhat Pazarçevirdi]

Doğru söylüyorsunuz. Bir kontrolü atlamışım sanırım.

13 Nolu mesajdaki kodları ve dosyayı revize ettim. İnceleyiniz.

 

[yesilcan]

hocam büyüksün.

hocam ellerine sağlık.tşk.ederim.sağol