T.C. Kimlik No Alanı Kontrolü

B

ByChilavert

Katılım
6 Mart 2011
Mesajlar
153
Excel Vers. ve Dili
Microsoft Office 2010
Merhaba

Arkadaşlar T.C. Kimlik No alanındaki basamak sayısı 11 mesela ben alt alta T.C. Kimlik Numaralarını girerken eksik yada fazla yazdığım zaman bana renklendirme yaparak uyarmasını istiyorum. Bunu araştırdım ama bir türlü bulamadım. Yardımcı olabilir misiniz.
 
Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
D2 Hücresinde aşağı doğru TC.Kimlik yazılı olduğu varsayılmıştır.
Koşullu biçimlendirme,Yeni kural,Hücreleri bicimlendirmek için formül kullan,
formülü alanına kopyala,dolgu rengi belirle, renklenmesini istediğin alanlar için biçim kopyala.Kolay gelsin
Kod: 
=VE(D2<>"";UZUNLUK(D2)<>11)
metin de yazılamasın isterseniz.
Kod: 
=YADA(VE(D2<>"";UZUNLUK(D2)<>11);EMETİNSE(D2))
 
Son düzenleme:
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Merhaba,
Renklendirme olmadan da uyarma olabilir.Veri girilecek sütünü seçin
Veri / Doğrulama / İzin verilen seçeneğinden Metin Uzunluğunda Arasında Yada Eşit bölümünden karakter sayısına sınırlama koyabilirsiniz..
 
H

hoguz2

Katılım
6 Ekim 2004
Mesajlar
250
Excel Vers. ve Dili
MSOffice 2010 TR
Altın Üyelik Bitiş Tarihi
19-11-2020
merhaba


mesela a sutununa tc kimlik numaralari giriyorsunuz diyelim asagidaki kodda a1 ile a10 arasında denetim yapiliyor kendinize gore rakami degistirin. TC kimlik in sadece 11 karakter olup olmadigina degil algoritmasina da bakiyor hatali girerseniz uyarir .. sayfa kodu bolumune yazin calismanız sayfa1 deyse sayfa1 icine yazilacak..

iyi calismalar.

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Intersect(Target, Range(["a1:a10"])) Is Nothing Then Exit Sub 'denetim yapilmasini istediginiz alan
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
 
Y

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
944
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Arkadaşlar macroyu uyguladım ama netice alamadım örnek dosya ekleyebilir misiniz
 
Seyit Tiken

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,651
Excel Vers. ve Dili
Excel : 2010
Bu şekilde deneyebilirsiniz
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range(["a1:a10"])) Is Nothing Then Exit Sub
If Target.Text = "" Then Exit Sub
If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
Target.Select
Exit Sub
End If
End Sub
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,305
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
Seyit Tiken' Alıntı:
Bu şekilde deneyebilirsiniz
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range(["a1:a10"])) Is Nothing Then Exit Sub
If Target.Text = "" Then Exit Sub
If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
Target.Select
Exit Sub
End If
End Sub
Genişletmek için tıkla ...
Hocam bunu ben de aramıştım. Emeğinize sağlık.
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,305
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
Aslında bunu T.C. Kimlik numarasını hatalı yazınca uyarması mümkün mü?
Numaranın bir formatı var. İşte sonu çift olacak gibi.
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,653
Excel Vers. ve Dili
Pro Plus 2021
A sütununda doğruluk kontrolu, B sütununda ise 9 rakam yazıldığı zaman son 2 rakamı kendisi hesaplar.


İlgili sayfanın kod kısmına eklenecek,
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [a:b]) Is Nothing Then
        Target.ClearComments
        If Target.Count > 1 Then Exit Sub
        If IsNumeric(Target.Value) Then
            If Not Intersect(Target, [a:a]) Is Nothing Then
                If tcKimlikKontrol(Target.Value) = False Then
                    Target.Select
                    AciklamaEkle
                    Target.Select
                End If
            Else
                If Len(Target.Value) = 9 Then Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
            End If
        End If
    End If
End Sub
Modül e eklenecek
Kod: 
Function tcKimlikKontrol(tc)
    Dim i As Byte
    If Len(tc) <> 11 Or Not IsNumeric(tc) Then tcKimlikKontrol = False: Exit Function
    For i = 0 To 9
        t = Val(Mid(tc, i + 1, 1))
        m1 = (m1 + (t * Array(7, -1, 7, -1, 7, -1, 7, -1, 7, 0)(i))) Mod 10
        m2 = (m2 + t) Mod 10
    Next i
    tcKimlikKontrol = Mid(tc, 10, 1) * 1 = m1 And Mid(tc, 11, 1) * 1 = m2
End Function
Function TCKimlikSon2CDKodEkle(tc)
    Dim i As Byte
    If Len(tc) <> 9 Or Not IsNumeric(tc) Then TCKimlikSon2CDKodEkle = tc: Exit Function
    For i = 0 To 8
        t = Val(Mid(tc, i + 1, 1))
        m1 = (m1 + (t * Array(7, -1, 7, -1, 7, -1, 7, -1, 7)(i))) Mod 10
        m2 = (m2 + t) Mod 10
    Next i
    TCKimlikSon2CDKodEkle = tc & m1 & (m1 + m2) Mod 10
End Function

Sub AciklamaEkle()
    With Selection
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:="HATALI TCKİMLİK "
        .Comment.Shape.Select
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
        .AutoSize = True
    End With
End Sub
 

Ekli dosyalar

Son düzenleme:
N

necati

Katılım
20 Şubat 2007
Mesajlar
675
Excel Vers. ve Dili
2007 Excel, Word Tr
Merhaba Veyselemre, güzel çalışma olmuş,
Eğer A ve B sütunları haricine bir şey yazılmak istenirse, kısır döngü oluyor.
If Intersect(Target, [a:a]) Is Nothing Then GoTo atla:
If Intersect(Target, [B:B]) Is Nothing Then GoTo atla:
 
5

52779

Katılım
21 Aralık 2016
Mesajlar
738
Excel Vers. ve Dili
Office 365 TR
Bilgi amaçlı olarak,
Excel 365 kullanıcıları için, belki faydalı olabilir düşüncesiyle,
daha önce hazırlamış olduğum TC Doğrulaması ile ilgili bir dokumanı paylaşmak istedim...

TC_Dogrulama_365.xlsx dosyasını indir - download

TC_Dogrulama_365.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle
s2.dosya.tc s2.dosya.tc

TC Doğrulamasındaki kriterler
1 - TC No sadece "RAKAM" lardan oluşmalı.
2 - TC No 11 adet RAKAM dan oluşmalı. TC No 11 haneden oluşmalı.
3 - TC No 0 ile başlamamalı.
4 - Baştan 10. hanedeki Rakamın doğrulanması..
5 - Son Rakamın (Baştan 11. hanedeki rakam) doğrulanması. Tek Sayı olmamalı.
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,653
Excel Vers. ve Dili
Pro Plus 2021
necati' Alıntı:
Merhaba Veyselemre, güzel çalışma olmuş,
Eğer A ve B sütunları haricine bir şey yazılmak istenirse, kısır döngü oluyor.
If Intersect(Target, [a:a]) Is Nothing Then GoTo atla:
If Intersect(Target, [B:B]) Is Nothing Then GoTo atla:
Genişletmek için tıkla ...
Haklısınız odak A:B sütunu olunca orası gözden kaçmış. Yukardaki mesajı düzenledim.
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,305
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
veyselemre' Alıntı:
A sütununda doğruluk kontrolu, B sütununda ise 9 rakam yazıldığı zaman son 2 rakamı kendisi hesaplar.


İlgili sayfanın kod kısmına eklenecek,
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [a:b]) Is Nothing Then
        Target.ClearComments
        If Target.Count > 1 Then Exit Sub
        If IsNumeric(Target.Value) Then
            If Not Intersect(Target, [a:a]) Is Nothing Then
                If tcKimlikKontrol(Target.Value) = False Then
                    Target.Select
                    AciklamaEkle
                    Target.Select
                End If
            Else
                If Len(Target.Value) = 9 Then Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
            End If
        End If
    End If
End Sub
Modül e eklenecek
Kod: 
Function tcKimlikKontrol(tc)
    Dim i As Byte
    If Len(tc) <> 11 Or Not IsNumeric(tc) Then tcKimlikKontrol = False: Exit Function
    For i = 0 To 9
        t = Val(Mid(tc, i + 1, 1))
        m1 = (m1 + (t * Array(7, -1, 7, -1, 7, -1, 7, -1, 7, 0)(i))) Mod 10
        m2 = (m2 + t) Mod 10
    Next i
    tcKimlikKontrol = Mid(tc, 10, 1) * 1 = m1 And Mid(tc, 11, 1) * 1 = m2
End Function
Function TCKimlikSon2CDKodEkle(tc)
    Dim i As Byte
    If Len(tc) <> 9 Or Not IsNumeric(tc) Then TCKimlikSon2CDKodEkle = tc: Exit Function
    For i = 0 To 8
        t = Val(Mid(tc, i + 1, 1))
        m1 = (m1 + (t * Array(7, -1, 7, -1, 7, -1, 7, -1, 7)(i))) Mod 10
        m2 = (m2 + t) Mod 10
    Next i
    TCKimlikSon2CDKodEkle = tc & m1 & (m1 + m2) Mod 10
End Function

Sub AciklamaEkle()
    With Selection
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:="HATALI TCKİMLİK "
        .Comment.Shape.Select
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
        .AutoSize = True
    End With
End Sub
Genişletmek için tıkla ...
Hocam öncelikle emeğinize sağlık.
Sub AciklamaEkle()
With Selection
.ClearComments
.AddComment
.Comment.Visible = True
.Comment.Text Text:="HATALI TCKİMLİK "
.Comment.Shape.Select
End With
Kısmı; hücreyi, doğruysa YEŞİL yanlışsa KIRMIZI nasıl yapabiliriz?
Teşekkür ederim.
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,653
Excel Vers. ve Dili
Pro Plus 2021
muratgunay48' Alıntı:
Hocam öncelikle emeğinize sağlık.
Kısmı; hücreyi, doğruysa YEŞİL yanlışsa KIRMIZI nasıl yapabiliriz?
Teşekkür ederim.
Genişletmek için tıkla ...
Açıklama eklemeden hücre rengini doğruysa yeşil değilse kırmızı yapar.
Sayfanın kod kısmındaki kodları aşağıdaki ile değiştirin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [a:b]) Is Nothing Then
        Target.Interior.Color = xlNone
        If Target.Count > 1 Then Exit Sub
        If IsNumeric(Target.Value) And Target.Value <> "" Then
            If Not Intersect(Target, [a:a]) Is Nothing Then
                If tcKimlikKontrol(Target.Value) = False Then
                    Target.Interior.Color = rgbRed
                Else
                    Target.Interior.Color = rgbPaleGreen
                End If
            Else
                If Len(Target.Value) = 9 Then Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
            End If
        End If
    End If
End Sub
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,305
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
veyselemre' Alıntı:
Açıklama eklemeden hücre rengini doğruysa yeşil değilse kırmızı yapar.
Sayfanın kod kısmındaki kodları aşağıdaki ile değiştirin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [a:b]) Is Nothing Then
        Target.Interior.Color = xlNone
        If Target.Count > 1 Then Exit Sub
        If IsNumeric(Target.Value) And Target.Value <> "" Then
            If Not Intersect(Target, [a:a]) Is Nothing Then
                If tcKimlikKontrol(Target.Value) = False Then
                    Target.Interior.Color = rgbRed
                Else
                    Target.Interior.Color = rgbPaleGreen
                End If
            Else
                If Len(Target.Value) = 9 Then Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
            End If
        End If
    End If
End Sub
Genişletmek için tıkla ...
Hocam emeğinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst