İban Numarası Girişinde Sınırlama

[ahmed_ummu]

Merhaba arkadaşlar

Ücretli_veri sayfasınuın D1 den itibaran girilen İban numarası girerken bazı şartlar olması gerekiyor.

26 Karakter olacak
İlk iki hanesi TR ile başlayacak ve kalanı sayısal olacak
Karakterler arasında boşluk olmayacak

ChatGPT den Veri doğrula ve vba kdu ile yardım aldıum ama vba kıodunda boşukları kabul ediytor ve 26 karakterden az veya fazla girsen yine kabul ediyor.
Veri doğrulam ile veridği formülde de tamama basınca bu formülde hata var diyor ve kabul etmiyor. ChatGPT nin verdiği formül ve kodlar aşağıdadır. Konu hakkında yardımcı oloursanız sevinirim.

'--------------------------------------------------------------------------------------------------------------------------------------------------------
ChatGPT Veri doğrulama formülü: =VE(SOLDAN(D1,2)="TR", UZUN(SUBSTITUTE(D1," ",""))=26, SAYI(ALAYAÇSIL(SUBSTITUTE(D1," ",""))))

'---------------------------------------------------------------------------------------------------------------------------------------------------------

ChatGPT VBA kodu

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim iban As String
Dim ibanLength As Integer

For Each cell In Target
If Not Intersect(cell, Me.Columns("D")) Is Nothing Then
' Hücredeki değeri al ve başındaki ve sonundaki boşlukları kaldır
iban = Trim(cell.Value)
ibanLength = Len(iban)

' Boşlukları kontrol et ve varsa kaldır
iban = Replace(iban, " ", "")
ibanLength = Len(iban)

' IBAN uzunluğunu kontrol et
If ibanLength = 26 Then
' İlk iki karakterin "TR" olduğunu kontrol et
If Left(iban, 2) = "TR" Then
' IBAN'nın sadece rakamlardan oluştuğunu kontrol et
If IsNumeric(iban) Then
' IBAN geçerli, devam et
Else
MsgBox "IBAN numarası sadece rakamlardan oluşmalıdır. Lütfen düzeltin.", vbExclamation
cell.Value = "" ' Hücreyi temizle
End If
Else
MsgBox "IBAN numarası 'TR' ile başlamalıdır. Lütfen düzeltin.", vbExclamation
cell.Value = "" ' Hücreyi temizle
End If
Else
MsgBox "IBAN numarası 26 karakter uzunluğunda olmalıdır. Lütfen düzeltin.", vbExclamation
cell.Value = "" ' Hücreyi temizle
End If
End If
Next cell
End Sub

 

[Muzaffer Ali]

Merhaba.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D")) Is Nothing Then
        
        If Len(Target.Value) <> 28 Then
            MsgBox "IBAN numarası 26 karakter uzunluğunda olmalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        ElseIf Left(Target.Value, 2) <> "TR" Then
            MsgBox "IBAN numarası 'TR' ile başlamalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        ElseIf Not IsNumeric(Replace(Target.Value, "TR", "")) Then
            MsgBox "IBAN numarası 'TR' ile başlamalı ve sadece rakamlardan oluşmalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        End If
        
    End If
End Sub

Sub Hata(Target As Range)
    Application.EnableEvents = False
    Target.Select
    'Target.Value = ""
    Application.EnableEvents = True
End Sub

 

[ahmed_ummu]

Merhaba.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D")) Is Nothing Then
       
        If Len(Target.Value) <> 28 Then
            MsgBox "IBAN numarası 26 karakter uzunluğunda olmalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        ElseIf Left(Target.Value, 2) <> "TR" Then
            MsgBox "IBAN numarası 'TR' ile başlamalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        ElseIf Not IsNumeric(Replace(Target.Value, "TR", "")) Then
            MsgBox "IBAN numarası 'TR' ile başlamalı ve sadece rakamlardan oluşmalıdır. Lütfen düzeltin.", vbExclamation
            Hata Target
            Exit Sub
        End If
       
    End If
End Sub

Sub Hata(Target As Range)
    Application.EnableEvents = False
    Target.Select
    'Target.Value = ""
    Application.EnableEvents = True
End Sub

Çokı teşekkürler Muzaffer Ali bey istediğim gibi çalışıyor.