arama özelliğini tc kimlik no'ya göre düzenlemek

[altunkaya26]

Dört bin civarında kayıt olan bir Excel kitabında arama yapıyorum. Ben arama kutusuna 11 basamaktan fazla rakam yazılmasın ve yazılan rakamlara tc kimlik no doğrulaması yapılsın istiyorum acaba mümkün müdür. Forumdaki konulara baktım bulumadım yardımcı olabilirmisiniz?

 

[Orion1]

Dört bin civarında kayıt olan bir Excel kitabında arama yapıyorum. Ben arama kutusuna 11 basamaktan fazla rakam yazılmasın ve yazılan rakamlara tc kimlik no doğrulaması yapılsın istiyorum acaba mümkün müdür. Forumdaki konulara baktım bulumadım yardımcı olabilirmisiniz?

Mümkündür.

 

[altunkaya26]

Ama nasıl mümmündür?

 

[Orion1]

Ama nasıl mümmündür?

Onu bilemiyecem sizin kısıtlı olarak verdiğiniz veriler ışığında ancak bu kadar cevap verebilirim.

 

[İhsan Tank]

selam arkadaşım örnek dosya haırlayıp uzman arkadaşlara sorarsanız daha net cevaplar alabilrsiniz_?

 

[altunkaya26]

İlgilenen arkadaşlara teşekkür ederim. Tarım bakanlığının çiftçi kayıt sistemi diye bir sistemi var. Yeşil kart vs. almaya gelenlerin tarımsal geliri var mı yok mu diye bu sisteme bakıyoruz. Fakat sistem bazen çok yavaş çalışıyor. Sistemin yıllık icmali var bu icmalde destekleme alanların adı soyadı tc kimlik numaraları vs. bilgileri var. Sistemin yavaş çalıştığı zamanlar ben bu icmalden (excel toblosu) daireye gelen vatandaşın destekleme alıp almadığını kontrol edip desetekleme almıyorsa geliri yoktur deyip işlemini yapmak hem vatandaşa hem kendime kolaylık sağlamak istiyorum. Ama 11 basamaklı bir sayıyı ararken 10 basamak yada 12 basamaklı bir sayı girip SONUÇ BULUNAMADI gibi bir cevap almak istemiyorum yada 11. rakamı yanlışlıkla 1 yerine 2 girip SONUÇ BULUNAMADI gibi bir cevap almak istemiyorum. Eminim böyle bir arama kodu yazan arkadaş olursa birçok işe yarar bu kodu yazacak arkadaşıma şimdiden teşekkür ediyorum

 

[Orion1]

O zaman siz girilen rakamın uzunluğunu sorgulamak istiyorsunuz?
Ayrıca arama döngü ile yapılıyorsa çok uzun sürer
Ben size A sütununda arama kodlarını vereyim.Gerçi siz hangi sütunda olduğunu söylemediniz ama olsun.Ne yapalım.Siz kenid sütununuza göre ayarlarsınız artık.
Kırmızı ile belirtitğim yerlere siz kendi sütununuzu yazın.
Bulduğunda bulduğu satırnda a sütununda se.çer.
Bulması 1-2 saniye sürer.

Sub bul()
Dim k As Range, tcno
tcno = InputBox("11 haneli Aranacak TC NO'yu giriniz :", "TC NO ARAMA")
If tcno = "" Then Exit Sub
If Len(tcno) <> 11 Then
    MsgBox "Lütfen 11 karakterlik bir değer giriniz.", vbCritical, "UYARI"
    Exit Sub
End If
Set k = Range("[B][COLOR="Red"]A:A[/COLOR][/B]").Find(tcno, , xlValues, xlWhole)
If Not k Is Nothing Then k.Select
End Sub

 

[Orion1]

Bu daha iyi oldu.
Bulamazsa mesaj veriyor.

Sub bul()
Dim k As Range, tcno
tcno = InputBox("11 haneli Aranacak TC NO'yu giriniz :", "TC NO ARAMA")
If tcno = "" Then Exit Sub
If Len(tcno) <> 11 Then
    MsgBox "Lütfen 11 karakterlik bir değer giriniz.", vbCritical, "UYARI"
    Exit Sub
End If
Set k = Range("[B][COLOR="Red"]A:A[/COLOR][/B]").Find(tcno, , xlValues, xlWhole)
If Not k Is Nothing Then
    k.Select
    Else
    MsgBox "[ " & tcno & " ] Bulunamadı.", vbCritical, "UYARI"
End If
End Sub

 

[altunkaya26]

Arkadaşım zaman ayırdığın için teşekkür ederim. Bu koda birde tc kimlik doğrulama kodunu ekleyebilir misin mümkün müdür? Kodu buldum ama nasıl yapılacağını bilmiyorum

Function TCKimlikOnYazimKontrol(tcid) As Boolean
Dim d(1 To 11) As Integer
If Len(tcid) <> 11 Or Not IsNumeric(tcid) Then
TCKimlikOnYazimKontrol = False
Else
For n = 1 To 11
d = Mid(tcid, n, 1)
Next
top1 = d(1) + d(3) + d(5) + d(7) + d(9)
top2 = d(2) + d(4) + d(6) + d(8)

cd1 = (10 - (((3 * top1) + top2) Mod 10)) Mod 10
cd2 = (10 - (((3 * (top2 + cd1)) + top1) Mod 10)) Mod 10
If cd1 = d(10) And cd2 = d(11) Then
TCKimlikOnYazimKontrol = True
Else
TCKimlikOnYazimKontrol = False
End If
End If
End Function
Birde bu arama kutusu bir arama yaptıktan sonra ben kapatıncaya kadar kapanmasa olur mu? NOT: Çok şey istediğimin farkındayım

 

[Orion1]

doğrulama kodu nedir?
Ney doğrulanacak?

 

[Orion1]

Sizin üstte verdiğiniz kodu boş bir modüle yazın
sonrada aşağıdaki kodları bir modüle koyun.Daha önceki verdiklerimi silin.

Sub bul()
Dim k As Range, tcno,kimlik as Boolean
tcno = InputBox("11 haneli Aranacak TC NO'yu giriniz :", "TC NO ARAMA")
If tcno = "" Then Exit Sub
If Len(tcno) <> 11 Then
    MsgBox "Lütfen 11 karakterlik bir değer giriniz.", vbCritical, "UYARI"
    Exit Sub
End If
if TCKimlikOnYazimKontrol(tcno) = false then
   msgbox "Kimlik doğrulaması yanlış çıktı",vbCritical, "UYARI"
   exit sub
end if
Set k = Range("A:A").Find(tcno, , xlValues, xlWhole)
If Not k Is Nothing Then
    k.Select
    Else
    MsgBox "[ " & tcno & " ] Bulunamadı.", vbCritical, "UYARI"
End If
End Sub

 

[altunkaya26]

Arkadaşım ben birden fazla arama yapacağım diğer özellikler önemli değil ama bu arama penceresi arama yapınca kapanmasa iyi olur şimdiden teşekkür ederim çalışmalarında başarılar dilerim. (dairede maaşları yapan arkadaşla da uğraştık ama yapamadık.)

 

[Orion1]

Arkadaşım ben birden fazla arama yapacağım diğer özellikler önemli değil ama bu arama penceresi arama yapınca kapanmasa iyi olur şimdiden teşekkür ederim çalışmalarında başarılar dilerim. (dairede maaşları yapan arkadaşla da uğraştık ama yapamadık.)

Pencerenin kapanmammasını istiyorsanız userform kullanmalısınız.
Örnek dosyayı ekleyin ben size yapayım.