IBAN kontrol

muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,311
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
Arkadaşlar bende (modül içinde) şöyle bir kod var. İşte A2'ye IBAN yazıyorsunuz. B2'ye Hatalı IBAN yazıyor.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

Function Mod97(Numero As String) As Integer
Nro = Numero
a = 0
B = 0
c = 0
e = Right(Nro, 6)
D = Mid(Nro, Len(Nro) - 11, 6)
Select Case Len(Nro)
 Case 13 To 20
   c = CDbl(Mid(Nro, 1, Len(Nro) - 12))
 Case 21 To 28
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   If Len(Nro) <> 20 Then B = CDbl(Mid(Nro, 1, Len(Nro) - 20))
 Case 29 To 36
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   B = CDbl(Mid(Nro, Len(Nro) - 27, 8))
   a = CDbl(Mid(Nro, 1, Len(Nro) - 28))
 Case Else
 Mod97 = "#VALEUR!"
 Exit Function
End Select
div97 = Int((a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) / 97)
Mod97 = (a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) - div97 * 97
End Function

Function convIBAN(lettre As String)
  convIBAN = (Asc(lettre) - 55)
End Function

Function ControleIban(LeNumIban As String) As String
Dim x As String
LeNumIban = Replace(LeNumIban, " ", "")
LeNumIban = Right(LeNumIban, Len(LeNumIban) - 4) & Left(LeNumIban, 4)
n = 1
While n <= Len(LeNumIban)
  x = Mid(LeNumIban, n, 1)
 If Not IsNumeric(x) Then
   LeNumIban = Replace(LeNumIban, x, convIBAN(x), 1, 1)
 End If
  n = n + 1
Wend
n_iban = Mod97(LeNumIban)
If n_iban = 1 Then
  ControleIban = "Doğru IBAN"
Else
  ControleIban = "Hatalı IBAN"
End If
End Function


End Sub

Eğer mümkünse, (aslında o da var ama 4'lü) ben bölmeyi başaramadım. Çok denedim. Olmadı. Örnek dosyaya. Sadece bir tek TextBox içine IBAN yazılacak. Yanındaki kutu, yanlışsa kırmızı, doğruysa yeşil olacak. Bunu bendeki personel dosyasına ekleyeceğim.
Yardımcı olabilir misiniz.
Teşekkür ederim.
 

Ekli dosyalar

I

iplikci_80

Altın Üye
Katılım
29 Kasım 2007
Mesajlar
1,110
Excel Vers. ve Dili
excel 2007
Altın Üyelik Bitiş Tarihi
07-03-2026
Deneyiniz, umarım işinize yarar.
 

Ekli dosyalar

A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Function kodlarını module2 ye yazdım.
Kod: 
Sub formaç()
UserForm1.Show 0
End Sub


Function Mod97(Numero As String) As Integer
Nro = Numero
a = 0
B = 0
c = 0
e = Right(Nro, 6)
D = Mid(Nro, Len(Nro) - 11, 6)
Select Case Len(Nro)
 Case 13 To 20
   c = CDbl(Mid(Nro, 1, Len(Nro) - 12))
 Case 21 To 28
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   If Len(Nro) <> 20 Then B = CDbl(Mid(Nro, 1, Len(Nro) - 20))
 Case 29 To 36
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   B = CDbl(Mid(Nro, Len(Nro) - 27, 8))
   a = CDbl(Mid(Nro, 1, Len(Nro) - 28))
 Case Else
 Mod97 = "#VALEUR!"
 Exit Function
End Select
div97 = Int((a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) / 97)
Mod97 = (a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) - div97 * 97
End Function

Function convIBAN(lettre As String)
  convIBAN = (Asc(lettre) - 55)
End Function

Function ControleIban(LeNumIban As String) As String
Dim x As String
LeNumIban = Replace(LeNumIban, " ", "")
LeNumIban = Right(LeNumIban, Len(LeNumIban) - 4) & Left(LeNumIban, 4)
n = 1
While n <= Len(LeNumIban)
  x = Mid(LeNumIban, n, 1)
 If Not IsNumeric(x) Then
   LeNumIban = Replace(LeNumIban, x, convIBAN(x), 1, 1)
 End If
  n = n + 1
Wend
n_iban = Mod97(LeNumIban)
If n_iban = 1 Then
  ControleIban = "Doğru IBAN"
Else
  ControleIban = "Hatalı IBAN"
End If
End Function
textbox olayına da aşağıdaki kodları yazdım.
Kod: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ControleIban(TextBox1.Text) = "Hatalı IBAN" Then
    TextBox2.BackColor = vbRed
Else
    TextBox2.BackColor = vbGreen
End If

End Sub
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,311
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
askm' Alıntı:
Function kodlarını module2 ye yazdım.
Kod: 
Sub formaç()
UserForm1.Show 0
End Sub


Function Mod97(Numero As String) As Integer
Nro = Numero
a = 0
B = 0
c = 0
e = Right(Nro, 6)
D = Mid(Nro, Len(Nro) - 11, 6)
Select Case Len(Nro)
 Case 13 To 20
   c = CDbl(Mid(Nro, 1, Len(Nro) - 12))
 Case 21 To 28
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   If Len(Nro) <> 20 Then B = CDbl(Mid(Nro, 1, Len(Nro) - 20))
 Case 29 To 36
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   B = CDbl(Mid(Nro, Len(Nro) - 27, 8))
   a = CDbl(Mid(Nro, 1, Len(Nro) - 28))
 Case Else
 Mod97 = "#VALEUR!"
 Exit Function
End Select
div97 = Int((a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) / 97)
Mod97 = (a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) - div97 * 97
End Function

Function convIBAN(lettre As String)
  convIBAN = (Asc(lettre) - 55)
End Function

Function ControleIban(LeNumIban As String) As String
Dim x As String
LeNumIban = Replace(LeNumIban, " ", "")
LeNumIban = Right(LeNumIban, Len(LeNumIban) - 4) & Left(LeNumIban, 4)
n = 1
While n <= Len(LeNumIban)
  x = Mid(LeNumIban, n, 1)
 If Not IsNumeric(x) Then
   LeNumIban = Replace(LeNumIban, x, convIBAN(x), 1, 1)
 End If
  n = n + 1
Wend
n_iban = Mod97(LeNumIban)
If n_iban = 1 Then
  ControleIban = "Doğru IBAN"
Else
  ControleIban = "Hatalı IBAN"
End If
End Function
textbox olayına da aşağıdaki kodları yazdım.
Kod: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ControleIban(TextBox1.Text) = "Hatalı IBAN" Then
    TextBox2.BackColor = vbRed
Else
    TextBox2.BackColor = vbGreen
End If

End Sub
Genişletmek için tıkla ...

Deneyip sonucu bildireceğim hocam. Teşekkür ederim. İş yerinde bilgisayarda açmadığım için. Lütfen, ilgisiz sanmayın.
Saygılarımla.
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,311
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
askm' Alıntı:
Function kodlarını module2 ye yazdım.
Kod: 
Sub formaç()
UserForm1.Show 0
End Sub


Function Mod97(Numero As String) As Integer
Nro = Numero
a = 0
B = 0
c = 0
e = Right(Nro, 6)
D = Mid(Nro, Len(Nro) - 11, 6)
Select Case Len(Nro)
Case 13 To 20
   c = CDbl(Mid(Nro, 1, Len(Nro) - 12))
Case 21 To 28
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   If Len(Nro) <> 20 Then B = CDbl(Mid(Nro, 1, Len(Nro) - 20))
Case 29 To 36
   c = CDbl(Mid(Nro, Len(Nro) - 19, 8))
   B = CDbl(Mid(Nro, Len(Nro) - 27, 8))
   a = CDbl(Mid(Nro, 1, Len(Nro) - 28))
Case Else
Mod97 = "#VALEUR!"
Exit Function
End Select
div97 = Int((a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) / 97)
Mod97 = (a * 93 + B * 73 + c * 50 + D * 27 + e Mod 97) - div97 * 97
End Function

Function convIBAN(lettre As String)
  convIBAN = (Asc(lettre) - 55)
End Function

Function ControleIban(LeNumIban As String) As String
Dim x As String
LeNumIban = Replace(LeNumIban, " ", "")
LeNumIban = Right(LeNumIban, Len(LeNumIban) - 4) & Left(LeNumIban, 4)
n = 1
While n <= Len(LeNumIban)
  x = Mid(LeNumIban, n, 1)
If Not IsNumeric(x) Then
   LeNumIban = Replace(LeNumIban, x, convIBAN(x), 1, 1)
End If
  n = n + 1
Wend
n_iban = Mod97(LeNumIban)
If n_iban = 1 Then
  ControleIban = "Doğru IBAN"
Else
  ControleIban = "Hatalı IBAN"
End If
End Function
textbox olayına da aşağıdaki kodları yazdım.
Kod: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ControleIban(TextBox1.Text) = "Hatalı IBAN" Then
    TextBox2.BackColor = vbRed
Else
    TextBox2.BackColor = vbGreen
End If

End Sub
Genişletmek için tıkla ...
Hocam. Mükemmel çalıştı. Teşekkür ederim. Emeğinize sağlık.
 
muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,311
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2026
iplikci_80' Alıntı:
Deneyiniz, umarım işinize yarar.
Genişletmek için tıkla ...
Hocam, emeğinize sağlık. Bende dosya vardı zaten. Bana personel dosyasına ekleyebilecek, yani bir yerde IBAN formatı şeklinde çalışacak şekilde lazımdı. Çok çok teşekkür ederim.
Saygılarımla.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst