Hatalı Eklenen Veriler Konusunda Uyarı

[universitelio]

Selamlar. Eklediğim dosyada puanlar ve bu puanlara denk gelen sıralamalar mevcur. Bazı zamanlarda yanlışlıkla girilen puanın sıralaması eksik ya da fazla giriliyor ve bu da veriyi farklı yerlerde kullanırken büyük sıkıntılar çıkarıyor. Aslında istediğim şey; girdiğim puanın sıralaması kendisinden bir alt ya da bir üsttekine göre hatalıysa uyarı vermesi. Kurguya dökecek olursam;
460 puan alan kişinin sıralaması; 1500
450 puan alan kişinin sıralaması; 2000
440 puan alan kişinin sıralaması; 2500 olsun. ben veri girerken 445 girdiğimde sıralamaya 2501 yazarsam uyarı vermesini istiyorum. Girilen veri sayısı fazla olunca bu tarz küçük hatalar çok baş ağrıtıyor maalesef. Yardımcı olursanız çok sevinirim.

Örnek dosyam; https://s2.dosya.tc/server31/aib3vv/Ornek_Dosyam.xlsx.html

 

[Muzaffer Ali]

Merhaba.

A2:B2 den itibaren aşağı doğru tüm hücreleri seçip
Koşullu biçimlendirme formül kısmına aşağıdaki formülü kopyalayıp istediğiniz biçimlendirmeyi yapın.

=VE(ESAYIYSA($A1); YADA($A2>$A1;$A2<$A3;$B2<$B1;$B2>$B3))

 

[Muzaffer Ali]

Veri doğrulama ile yapmak için

A2 hücresini seçip veri doğrulama İzin verilen = Özel seçin.
Formül kısmına =VE(A1>A2;A3<A2) formülünü kopyalayın.
Giriş uyarısı ve Hata iletisi kısmını isterseniz doldurun.
Tamamı tıklatın.

A2 hücresini kopyalayın A:B sütunlarını seçip Özel Yapıştır kısmından Doğrulama seçip Tamamı tıklatın.

 

[universitelio]

Muzaffer hocam hücre vurgulama kurallarını mı seçmeliyim yoksa yeni kural mı demeliyim?

 

[Muzaffer Ali]

Muzaffer hocam hücre vurgulama kurallarını mı seçmeliyim yoksa yeni kural mı demeliyim?

Yeni Kural seçmelisiniz.
Ardından listeden "... ... ... formül kullan" seçin.

 

[universitelio]

Hocam elinize sağlık. Ancak tam olarak çalışmadı. Örnek dosyamda 20. satırın sıralamasını yani B sütununu bilerek 21. satırdakinden daha düşük yaptım. Ama aslında yüksek olması gerekiyor. Ancak burasını vurgulamadı.

 

[Muzaffer Ali]

Örnek dosyanıza hem Koşullu Biçimlendirme ve hem de Veri Doğrulama uygulanmış şekli ile ektedir.

İndir Ornek Dosyam xlsx

Dosyayı indir Ornek Dosyam xlsx

dosya.co

 

[universitelio]

Muzaffer Bey elinize sağlık. Anladığım kadarıyla A eklenen sütununa eklenen sayıların da sıralı biçimde olması gerekiyor. Sadece meraktan soruyorum; A biçimi büyükten küçüğe veya tam tersi şekilde sıralı olmasa, karışık olsa da bu sağlanabilir miydi?

 

[Muzaffer Ali]

Muzaffer Bey elinize sağlık. Anladığım kadarıyla A eklenen sütununa eklenen sayıların da sıralı biçimde olması gerekiyor. Sadece meraktan soruyorum; A biçimi büyükten küçüğe veya tam tersi şekilde sıralı olmasa, karışık olsa da bu sağlanabilir miydi?

Mutlaka yapılabilir. Eğer dilerseniz formül ile değil ama kod ile yapabilirim.

 

[universitelio]

Sizi yormayacaksam çok çok iyi olur.

 

[universitelio]

Mutlaka yapılabilir. Eğer dilerseniz formül ile değil ama kod ile yapabilirim.

Muzaffer hocam bakma imkanınız oldu mu?

 

[Muzaffer Ali]

Sayfanın kod kısmına aşağıdaki kodu kopyalayın.
B sütununa bir değer girdiğinizde yada değiştirdiğinizde kod otomatik çalışacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Buyuk As Variant
    Dim Kucuk As Variant
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Buyuk = Replace(Evaluate("MIN(IF(" & Cells(Target.Row, "A").Address & "<A:A,A:A))"), ",", ".")
        Kucuk = Replace(Evaluate("MAX(IF(A:A<" & Cells(Target.Row, "A").Address & ",A:A))"), ",", ".")
        Buyuk = Evaluate("VLOOKUP(" & Buyuk & ", A:B, 2, FALSE)")
        Kucuk = Evaluate("VLOOKUP(" & Kucuk & ", A:B, 2, FALSE)")
        
        If Target <> "" And Buyuk <> 0 And Kucuk <> 0 And (Buyuk > Target.Value Or Kucuk < Target.Value) Then
            Target.Select
            MsgBox "Yanlış sıralama." & vbLf & vbLf & "Lütfen puan ve sıralamayı kontrol ediniz.", vbExclamation, "Sıralama Hatası"
            Application.EnableEvents = False
            Target = ""
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[universitelio]

Sayfanın kod kısmına aşağıdaki kodu kopyalayın.
B sütununa bir değer girdiğinizde yada değiştirdiğinizde kod otomatik çalışacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Buyuk As Variant
    Dim Kucuk As Variant
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Buyuk = Replace(Evaluate("MIN(IF(" & Cells(Target.Row, "A").Address & "<A:A,A:A))"), ",", ".")
        Kucuk = Replace(Evaluate("MAX(IF(A:A<" & Cells(Target.Row, "A").Address & ",A:A))"), ",", ".")
        Buyuk = Evaluate("VLOOKUP(" & Buyuk & ", A:B, 2, FALSE)")
        Kucuk = Evaluate("VLOOKUP(" & Kucuk & ", A:B, 2, FALSE)")
       
        If Target <> "" And Buyuk <> 0 And Kucuk <> 0 And (Buyuk > Target.Value Or Kucuk < Target.Value) Then
            Target.Select
            MsgBox "Yanlış sıralama." & vbLf & vbLf & "Lütfen puan ve sıralamayı kontrol ediniz.", vbExclamation, "Sıralama Hatası"
            Application.EnableEvents = False
            Target = ""
            Application.EnableEvents = True
        End If
    End If
End Sub

Muzaffer hocam bazı sorunlardan dolayı bir süredir buraya giriş yapamıyordum. Elinize emeğinize sağlık. İyiki varsınız!