TC Kimlik No Doğrulama

gumusmustafa · 3 Haziran 2013

Merhaba üstadlar,

Müşteri listelerimi kolaylaştırmak ve zaman yaratmak için bir arayüz oluştrmaya çalışıyorum. Bu noktada işimi en kolay hale sokacak işlemlerden biriside yazdığım TCKN numarasının algoritmaya uygun olup olmadığının sorgulanması. Yani hatalı TCKN numarası girilsin istemiyorum. Sayfalarda bulduğum birçok formülü denesemde başarılı bir sonuç alamadım. Sanırım sebebi acemilik.

Dosyayı ekliyorum, TC Kimlik No yazan kısma yanlış bir TC yazıldığında uyarı vermesini ve istiyorum.

Teşekkür ederim.

suleyman242 · 3 Haziran 2013

gumusmustafa' Alıntı:
Merhaba üstadlar,

Müşteri listelerimi kolaylaştırmak ve zaman yaratmak için bir arayüz oluştrmaya çalışıyorum. Bu noktada işimi en kolay hale sokacak işlemlerden biriside yazdığım TCKN numarasının algoritmaya uygun olup olmadığının sorgulanması. Yani hatalı TCKN numarası girilsin istemiyorum. Sayfalarda bulduğum birçok formülü denesemde başarılı bir sonuç alamadım. Sanırım sebebi acemilik.

Dosyayı ekliyorum, TC Kimlik No yazan kısma yanlış bir TC yazıldığında uyarı vermesini ve istiyorum.

Teşekkür ederim.

Formunuza uğraş vermissiniz , tam olarak sorunuzu anlamamakla birlikte; formda daha önce bu konuda çok güzel bir anlatım bulmuştum sizinle paylaşmak istedim çok işinize yarayacağına eminim, Dilerim sorunuzu yanlış anlamamışımdır.

http://www.excel.web.tr/f165/regexp-ile-textboxta-yazym-ekli-kontrolu-t59337.html
Ayrıca levent Menteşoğlu hocama teşekkürler!

Bir başka link:
http://www.excel.web.tr/f48/beraber-kullanylan-sayy-ve-metin-formaty-t129817.html

gumusmustafa · 3 Haziran 2013

Süleyman242 öncelikle teşekkür ederim, bu da formu kolaylaştırmak için çok işime yarayacak. Ancak istediğim tam olarak bu değil.
TC Kimlik Numarasının doğru olup olmadığını kontrol eden bir algoritma var.

Örn:
----------------------------------------
Public Shared Function TcDogrulaV2(ByVal tcKimlikNo As String) As Boolean
Dim returnvalue As Boolean = False
If (tcKimlikNo.Length <> 11) Then
Return returnvalue
End If
Dim TcNo As Long = Long.Parse(tcKimlikNo)
Dim ATCNO As Long = (TcNo / 100)
Dim BTCNO As Long = (TcNo / 100)
Dim C1 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C2 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C3 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C4 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C5 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C6 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C7 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C8 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim C9 As Long = (ATCNO Mod 10)
ATCNO = (ATCNO / 10)
Dim Q1 As Long =((10-(((((((C1+C3)+C5)+C7)+C9)*3)+(((C2+C4)+C6)+C8))Mod 10))Mod 10)
Dim Q2 As Long =((10-(((((((C2+C4)+C6)+C8)+Q1)*3)+((((C1+C3)+C5)+C7)+C9))Mod 10))Mod 10)
Return ((((BTCNO * 100) + (Q1 * 10)) + Q2) = TcNo)
End Function

-------------------------------------------

Ben bu kodu TC Kimlik numarası satırı için kullanmayı beceremedim.

Yani TCKN numarasını girdiğimde doğrumu yanlış mı bunu belirtsin istiyorum.

omeryılmaz · 3 Haziran 2013

UserForm Kod sayfasına;

Private Sub TextBox46_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
If TextBox46.TextLength <> 11 Then
'MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
TextBox46.Text = ""
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(TextBox46, 1, 1)
TC2 = Mid(TextBox46, 2, 1)
TC3 = Mid(TextBox46, 3, 1)
TC4 = Mid(TextBox46, 4, 1)
TC5 = Mid(TextBox46, 5, 1)
TC6 = Mid(TextBox46, 6, 1)
TC7 = Mid(TextBox46, 7, 1)
TC8 = Mid(TextBox46, 8, 1)
TC9 = Mid(TextBox46, 9, 1)
TC10 = Mid(TextBox46, 10, 1)
TC11 = Mid(TextBox46, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then
MsgBox TextBox2 & " Geçerli TC kimlik numarası", vbInformation, "Bilgilendirme !"
Else
MsgBox TextBox46 & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
TextBox46.Text = ""
End If

End Sub

yazınız... yeterli olacaktır.

gumusmustafa · 3 Haziran 2013

Teşekkür Ederim,

omeryılmaz çözümün tamda yerine oturdu

Ellerine sağlık.

BLACKICE · 5 Haziran 2013

Bunu excelde öğrenğin a1 hücresine girilen bir tc kimlik numarasını kontrol ettirmek istesek nasıl bir makro kodu gerekiyor

YUSUF44 · 5 Haziran 2013

Arkadaşların kodlarından faydalanarak oluşturduğum şu kodları, ilgili sayfanın kod bölümüne yapıştırarak deneyiniz:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Intersect(Target, Range(["a1"])) Is Nothing Then Exit Sub
If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
'Target.Text = ""
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(Target, 1, 1)
TC2 = Mid(Target, 2, 1)
TC3 = Mid(Target, 3, 1)
TC4 = Mid(Target, 4, 1)
TC5 = Mid(Target, 5, 1)
TC6 = Mid(Target, 6, 1)
TC7 = Mid(Target, 7, 1)
TC8 = Mid(Target, 8, 1)
TC9 = Mid(Target, 9, 1)
TC10 = Mid(Target, 10, 1)
TC11 = Mid(Target, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then
MsgBox Target & " Geçerli TC kimlik numarası", vbInformation, "Bilgilendirme !"
Else
MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
End If

End Sub

mcetinkaya65 · 5 Haziran 2013

Yusuf44 elinize sağlık,
A1 hücresinde geçerli bir makro.Bunu A stununun tamamında yapamazmıyız.
Saygılarımla..

halit3 · 6 Haziran 2013

Alternatif kod.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range(["a:a"])) Is Nothing Then Exit Sub
Dim i As Integer

For i = 1 To Len(Target)
Sayi = Mid(Target, i, 1)
If IsNumeric(Sayi) = True Then
SAYILARIBUL = SAYILARIBUL & Sayi
End If
Next

If Len(SAYILARIBUL) <> 11 Or Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
Exit Sub
End If

End Sub

mcetinkaya65 · 6 Haziran 2013

Teşekkürler..

furens · 12 Aralık 2013

YUSUF 44 Hocam:
çok güzel bir paylaşım teşekkürler. kullanırken bir hata ile karşılaştım. TC nin bulunduğu satırı silmek istediğimde , o hücreyi delete ile sildiğimde ve birkakaç hücreyi seçip sildiğimde hata veriyor. bunu nasıl giderebiliriz.
silindiği zaman hata vermemesini nasıl önleriz*

YUSUF44 · 12 Aralık 2013

mcetinkaya65' Alıntı:
Yusuf44 elinize sağlık,
A1 hücresinde geçerli bir makro.Bunu A stununun tamamında yapamazmıyız.
Saygılarımla..

Biraz geç oldu kusura bakmayın:

Kod:

If Intersect(Target, Range(["a1"])) Is Nothing Then Exit Sub

satırını

Kod:

If Intersect(Target, Range(["a:a"])) Is Nothing Then Exit Sub

olarak değiştirirseniz a sütununda kullanabilirsiniz.

furens · 15 Aralık 2013

YUSUF 44 Hocam:
çok güzel bir paylaşım teşekkürler. kullanırken bir hata ile karşılaştım. TC nin bulunduğu satırı silmek istediğimde , o hücreyi delete ile sildiğimde ve birkakaç hücreyi seçip sildiğimde hata veriyor. bunu nasıl giderebiliriz.
silindiği zaman hata vermemesini nasıl önleriz*

SaFF3T · 3 Temmuz 2015

Herhangi bir hücrede hesaplamak üzere geliştirdiğim kodu sizlerle paylaşmak istiyorum. Umarım işinize yarar.

Kod:

Function TCKN(x As String)
    Dim buff() As String
    Dim tekToplam As Integer
    Dim ciftToplam As Integer
    Dim uzunluk As Integer
    Dim toplamlar As Integer
    Dim onuncuRakam As Integer
    Dim onbirinciRakam As Integer
    
    buff = Split(StrConv(x, vbUnicode), Chr$(0))
    ReDim Preserve buff(UBound(buff) - 1)
    
    uzunluk = Application.CountA(buff)
    
    If Len(x) <> 11 Then
        TCKN = "Hatalı TCKN (11/" & uzunluk & ")!"
    ElseIf buff(uzunluk - 1) Mod 2 <> 0 Then
        TCKN = "Hatalı TCKN (11.2)!"
    ElseIf buff(0) = 0 Then
        TCKN = "Hatalı TCKN (0)!"
    Else
        For i = 0 To uzunluk - 1
            If i Mod 2 <> 0 And i > 0 And i < 9 Then
                ciftToplam = ciftToplam + buff(i)
            ElseIf i < 9 Then
                tekToplam = tekToplam + buff(i)
            End If
            If i < uzunluk - 1 Then
                toplamlar = toplamlar + buff(i)
            End If
        Next i
        
        onuncuRakam = ((tekToplam * 7) - ciftToplam) Mod 10
        onbirinciRakam = (toplamlar Mod 10)
        
        If onuncuRakam <> buff(uzunluk - 2) Then
            TCKN = "Hatalı TCKN (10)"
        ElseIf onbirinciRakam <> buff(uzunluk - 1) Then
            TCKN = "Hatalı TCKN (11)!"
        Else
            TCKN = ""
        End If
    End If
End Function

mharisma · 6 Mart 2017

=eğer(mod(mod(((parçaal(c5;1;1)+parçaal(c5;2;1)+parçaal(c5;3;1)+parçaal(c5;4;1)+parçaal(c5;5;1)+parçaal(c5;6;1)+parçaal(c5;7;1)+parçaal(c5;8;1)+parçaal(c5;9;1)+parçaal(c5;10;1)));1000);10)+1=parçaal(c5;11;1)+1;"doğru";"yanlış")

mcetinkaya65 · 30 Eylül 2019

SaFF3T' Alıntı:

Herhangi bir hücrede hesaplamak üzere geliştirdiğim kodu sizlerle paylaşmak istiyorum. Umarım işinize yarar.

Kod:

Function TCKN(x As String)
    Dim buff() As String
    Dim tekToplam As Integer
    Dim ciftToplam As Integer
    Dim uzunluk As Integer
    Dim toplamlar As Integer
    Dim onuncuRakam As Integer
    Dim onbirinciRakam As Integer
   
    buff = Split(StrConv(x, vbUnicode), Chr$(0))
    ReDim Preserve buff(UBound(buff) - 1)
   
    uzunluk = Application.CountA(buff)
   
    If Len(x) <> 11 Then
        TCKN = "Hatalı TCKN (11/" & uzunluk & ")!"
    ElseIf buff(uzunluk - 1) Mod 2 <> 0 Then
        TCKN = "Hatalı TCKN (11.2)!"
    ElseIf buff(0) = 0 Then
        TCKN = "Hatalı TCKN (0)!"
    Else
        For i = 0 To uzunluk - 1
            If i Mod 2 <> 0 And i > 0 And i < 9 Then
                ciftToplam = ciftToplam + buff(i)
            ElseIf i < 9 Then
                tekToplam = tekToplam + buff(i)
            End If
            If i < uzunluk - 1 Then
                toplamlar = toplamlar + buff(i)
            End If
        Next i
       
        onuncuRakam = ((tekToplam * 7) - ciftToplam) Mod 10
        onbirinciRakam = (toplamlar Mod 10)
       
        If onuncuRakam <> buff(uzunluk - 2) Then
            TCKN = "Hatalı TCKN (10)"
        ElseIf onbirinciRakam <> buff(uzunluk - 1) Then
            TCKN = "Hatalı TCKN (11)!"
        Else
            TCKN = ""
        End If
    End If
End Function

Bu kodları çalıştıramadım
Saygılarımla

maliex · 1 Ekim 2019

vergi kimlik numarası içinde var mı bu tür algoritma ?

mcetinkaya65 · 14 Mayıs 2020

YUSUF44' Alıntı:
Biraz geç oldu kusura bakmayın:

Kod:

If Intersect(Target, Range(["a1"])) Is Nothing Then Exit Sub

satırını

Kod:

If Intersect(Target, Range(["a:a"])) Is Nothing Then Exit Sub

olarak değiştirirseniz a sütununda kullanabilirsiniz.

Üstad kodlar çalışıyor.Güzel. Fakat yanlış tc yi hatırlatma değilde mümkünse yazdırmasa engellese..

TURKOLOG · 14 Mayıs 2020

https://www.excel.web.tr/threads/t-c-kimlik-no-dogrulama.183690/ bu link işinize yarayabilir.

YUSUF44 · 14 Mayıs 2020

furens' Alıntı:
YUSUF 44 Hocam:
çok güzel bir paylaşım teşekkürler. kullanırken bir hata ile karşılaştım. TC nin bulunduğu satırı silmek istediğimde , o hücreyi delete ile sildiğimde ve birkakaç hücreyi seçip sildiğimde hata veriyor. bunu nasıl giderebiliriz.
silindiği zaman hata vermemesini nasıl önleriz*

mcetinkaya65' Alıntı:
Üstad kodlar çalışıyor.Güzel. Fakat yanlış tc yi hatırlatma değilde mümkünse yazdırmasa engellese..

Her iki isteği de karşılayan kodun son hali şu şekildedir:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Len(Target) <> 11 Then
    MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
    Target.ClearContents
    Target.Select
    Exit Sub
ElseIf IsNumeric(Target) = False Then
    MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
    Target.ClearContents
    Target.Select
    Exit Sub
Else
    Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, _
    TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, _
    TC9 As Integer, TC10 As Integer, TC11 As Integer
    
    TC1 = Mid(Target, 1, 1)
    TC2 = Mid(Target, 2, 1)
    TC3 = Mid(Target, 3, 1)
    TC4 = Mid(Target, 4, 1)
    TC5 = Mid(Target, 5, 1)
    TC6 = Mid(Target, 6, 1)
    TC7 = Mid(Target, 7, 1)
    TC8 = Mid(Target, 8, 1)
    TC9 = Mid(Target, 9, 1)
    TC10 = Mid(Target, 10, 1)
    TC11 = Mid(Target, 11, 1)
    
    mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
    mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)
    
    If mod1 = TC10 And mod2 = TC11 Then
        MsgBox Target & " Geçerli TC kimlik numarası", vbInformation, "Bilgilendirme !"
    Else
        MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
        Target.ClearContents
        Target.Select
    End If
End If
End Sub

TC Kimlik No Doğrulama

gumusmustafa

Ekli dosyalar

suleyman242

gumusmustafa

omeryılmaz

gumusmustafa

BLACKICE

YUSUF44

Destek Ekibi

mcetinkaya65

halit3

Uzman

mcetinkaya65

furens

YUSUF44

Destek Ekibi

furens

SaFF3T

mharisma

mcetinkaya65

maliex

mcetinkaya65

TURKOLOG

YUSUF44

Destek Ekibi