• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

IBAN Numarası

Katılım
29 Kasım 2007
Mesajlar
1,110
Excel Vers. ve Dili
excel 2007
Arkadaşlar EK'teki çalışmada "CARİLER" sayfasındaki herhangi bir cari adına çift tıkladığımda o cari adına yeni bir şablon oluşturan bir kod mavcut. Benim burada yapmak istediğim şey mevcut kodları revize ederek "ŞABLON" sayfasındaki C7 hücresine yazacağım IBAN numaralarının TR35 0006 7010 0000 0044 9112 44 şeklinde olmasını sağlamak istiyorum.
 

Ekli dosyalar

Makro kodu ile Sayfanın kod kısmına aşağıdaki kodu yazın..

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Son
    If Intersect(Target, [c:c]) Is Nothing Or _
        Target.Row < 2 Or _
        Target.Value = "" Then Exit Sub

    Application.EnableEvents = False
    With Target
        .Interior.ColorIndex = xlNone
        .Font.ColorIndex = 1
        .Font.Bold = False
    End With

    Dim IBAN, iban1
    Target.Value = Trim(Replace(Target.Value, " ", ""))
    IBAN = Target.Value

    If Len(IBAN) < 1 Then End
    If Len(IBAN) <> 26 Then
        MsgBox "Girdiğiniz numara " & Len(IBAN) & " hanedir " & Chr(10) & "Türk Bankaları için IBAN numarası 26 haneli bir numaradır.", , " IBAN Numaranız Yanlış"
        Target.Select
        Exit Sub
    End If

    IBAN = Right(IBAN, 22) & Left(IBAN, 4)
    IBAN = Replace(IBAN, "A", 10)
    IBAN = Replace(IBAN, "B", 11)
    IBAN = Replace(IBAN, "C", 12)
    IBAN = Replace(IBAN, "D", 13)
    IBAN = Replace(IBAN, "E", 14)
    IBAN = Replace(IBAN, "F", 15)
    IBAN = Replace(IBAN, "G", 16)
    IBAN = Replace(IBAN, "H", 17)
    IBAN = Replace(IBAN, "I", 18)
    IBAN = Replace(IBAN, "J", 19)
    IBAN = Replace(IBAN, "K", 20)
    IBAN = Replace(IBAN, "L", 21)
    IBAN = Replace(IBAN, "M", 22)
    IBAN = Replace(IBAN, "N", 23)
    IBAN = Replace(IBAN, "O", 24)
    IBAN = Replace(IBAN, "P", 25)
    IBAN = Replace(IBAN, "Q", 26)
    IBAN = Replace(IBAN, "R", 27)
    IBAN = Replace(IBAN, "S", 28)
    IBAN = Replace(IBAN, "T", 29)
    IBAN = Replace(IBAN, "U", 30)
    IBAN = Replace(IBAN, "V", 31)
    IBAN = Replace(IBAN, "W", 32)
    IBAN = Replace(IBAN, "X", 33)
    IBAN = Replace(IBAN, "Y", 34)
    IBAN = Replace(IBAN, "Z", 35)

    iban1 = Left(IBAN, 4) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 5, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 7, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 9, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 11, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 13, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 15, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 17, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 19, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 21, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 23, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 25, 2)) Mod 97
    iban1 = Val(iban1 & Mid(IBAN, 27, 2)) Mod 97

        If iban1 = 1 Then
            Target.Value = Left(Target.Value, 4) & " " & _
                          Mid(Target.Value, 5, 4) & " " & _
                          Mid(Target.Value, 9, 4) & " " & _
                          Mid(Target.Value, 13, 4) & " " & _
                          Mid(Target.Value, 17, 4) & " " & _
                          Mid(Target.Value, 21, 4) & " " & _
                          Mid(Target.Value, 25, 2)
        Else
            With Target
                .Interior.ColorIndex = 3
                .Font.ColorIndex = 2
                .Font.Bold = True
            End With
        End If
Son:
    Application.EnableEvents = True

End Sub
 
Sayın htsumer ilginize teşekkürler.
 
Geri
Üst