DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[COLOR=#0600ff]If[/COLOR] [COLOR=#0600ff]Right[/COLOR][COLOR=#000000]([/COLOR][COLOR=#0600ff]Me[/COLOR].metin_kutusu_adi, [COLOR=#7d2252]1[/COLOR][COLOR=#000000])[/COLOR] [COLOR=#0600ff]Mod[/COLOR] [COLOR=#7d2252]2[/COLOR] [COLOR=#0600ff]Then[/COLOR]
MsgBox [COLOR=#fb0000]"TC Kimlik numarası Tek sayı olmaz"[/COLOR], vbCritical
[COLOR=#0600ff]Me[/COLOR].Undo
[COLOR=#0600ff]End[/COLOR] [COLOR=#0600ff]If[/COLOR]
Public Function dogrula(kimlikNo As String) As String
Dim x, Top1, Top2, H1, H2 As Integer
ReDim A(11) As Variant
If Len(kimlikNo) <> 11 Then
MsgBox "TC Kimlik No 11 Haneli olmalıdır", vbCritical, "UYARI"
dogrula = "Yanlış veri"
Exit Function
End If
For x = 0 To 10
A(x) = CInt(Mid(kimlikNo, x + 1, 1))
Next x
Top1 = 3 * (A(0) + A(2) + A(4) + A(6) + A(8)) + (A(1) + A(3) + A(5) + A(7))
H1 = 10 - Top1 Mod 10
If H1 = 10 Then H1 = 0
Top2 = (A(0) + A(2) + A(4) + A(6) + A(8)) + 3 * (A(1) + A(3) + A(5) + A(7) + H1)
H2 = 10 - Top2 Mod 10
If H2 = 10 Then H2 = 0
If H1 = A(9) And H2 = A(10) Then
dogrula = "Doğru TC Kimlik No"
Else
dogrula = "Yanlış TC Kimlik No"
End If
End Function
Evet çalışırSayın Taruz
Geçerlilik kuralına dogrula([TC Kimlik Numarası])
yazsak fonksiyon çalışır mı?