TC Kimlik No Doğrulama

Katılım
29 Mayıs 2013
Mesajlar
3
Excel Vers. ve Dili
Office 2010 türkçe
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.
 

Ekli dosyalar

Katılım
21 Ekim 2010
Mesajlar
865
Excel Vers. ve Dili
türkçe 2010
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
 
Katılım
29 Mayıs 2013
Mesajlar
3
Excel Vers. ve Dili
Office 2010 türkçe
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.
 
Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
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.
 
Katılım
29 Mayıs 2013
Mesajlar
3
Excel Vers. ve Dili
Office 2010 türkçe
Teşekkür Ederim,

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

Ellerine sağlık.
 
Katılım
17 Kasım 2004
Mesajlar
9
Bunu excelde öğrenğin a1 hücresine girilen bir tc kimlik numarasını kontrol ettirmek istesek nasıl bir makro kodu gerekiyor
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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

Altın Üye
Katılım
1 Mart 2011
Mesajlar
487
Excel Vers. ve Dili
2019 türkçe
Yusuf44 elinize sağlık,
A1 hücresinde geçerli bir makro.Bunu A stununun tamamında yapamazmıyız.
Saygılarımla..
 
Son düzenleme:

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 
Katılım
24 Aralık 2007
Mesajlar
130
Excel Vers. ve Dili
2007 Tr
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*
 
Son düzenleme:

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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.
 
Katılım
24 Aralık 2007
Mesajlar
130
Excel Vers. ve Dili
2007 Tr
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*
 
Katılım
9 Mart 2012
Mesajlar
1
Excel Vers. ve Dili
2010 Türkçe
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
 
Katılım
6 Mart 2017
Mesajlar
1
Excel Vers. ve Dili
2007 Türkçe
=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

Altın Üye
Katılım
1 Mart 2011
Mesajlar
487
Excel Vers. ve Dili
2019 türkçe
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

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
220
Excel Vers. ve Dili
professional plus 2016-türkçe
vergi kimlik numarası içinde var mı bu tür algoritma ?
 

mcetinkaya65

Altın Üye
Katılım
1 Mart 2011
Mesajlar
487
Excel Vers. ve Dili
2019 türkçe
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..
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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*
Ü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
 
Üst