چگونه در اکسل شماره شبا را کنترل کنیم ؟

جام میدهیم.

1. با زدن کلیدهای Alt + F11 به کدنویسی بروید.
2. در فضای مربوط به ماژولها کلیک راست کرده و گزینه Insert و سپس Module را انتخاب کنید.
3. کدهای زیر را در آنجا قرار دهید.
4. بهتر است در آن واحد فقط یک فایل باز اکسل داشته باشید 
5. فایل را با پسوند XLSM ماکرو اینیبل ذخیره کنید.
6. فرض می کنیم شماره شبا را در A2 وارد کرده اید.
7. کافیست در B2 از تابع VALIDATEIBAN(A2) استفاده نمائید.

Public Function VALIDATEIBAN(ByVal IBAN As String) As String
    On Error GoTo CatchError
    Dim objRegExp As Object
    Dim IBANformat As Boolean
    Dim IBANNR As String
    Dim ReplaceChr As String
    Dim ReplaceBy As String
    IBAN = UCase(IBAN)
    IBAN = Replace(IBAN, " ", "")
    IBAN = Trim(IBAN)
    Set objRegExp = CreateObject("vbscript.regexp")
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "[a-zA-Z]{2}[0-9]{2}[a-zA-Z0-9]{4}[0-9]{7}([a-zA-Z0-9]?){0,16}"
    IBANformat = objRegExp.Test(IBAN)

    'Validity of country code will not be checked!
    If IBANformat = False Then
        VALIDATEIBAN = ChrW(1582) & ChrW(1575) & ChrW(1604) & ChrW(1740) & " " & ChrW(1740) & ChrW(1575) & " " & ChrW(1601) & ChrW(1585) & ChrW(1605) & ChrW(1578) & " " & ChrW(1606) & ChrW(1575) & ChrW(1583) & ChrW(1585) & ChrW(1587) & ChrW(1578)
    Else
        'Flip first 4 characters to the back
        IBANNR = Right(IBAN, Len(IBAN) - 4) & Left(IBAN, 4)

        'Replace letters by the right numbers
        For Nr = 10 To 35
            ReplaceChr = Chr(Nr + 55)
            ReplaceBy = Trim(Str(Nr))
            IBANNR = Replace(IBANNR, ReplaceChr, ReplaceBy)
        Next Nr

        'Loop through the IBAN, as it is too long to calculate at one go
        CurrPart = ""
        Answer = ""
        For CurrDigit = 1 To Len(IBANNR)
            CurrPart = CurrPart & Mid$(IBANNR, CurrDigit, 1)
            CurrNumber = CLng(CurrPart)
            'If the number can be divided
            If 97 <= CurrNumber Then
                LeftOver = CurrNumber Mod 97
                WorkValue = (CurrNumber - LeftOver) / 97
                Answer = Answer & CStr(WorkValue)
                CurrPart = CStr(LeftOver)
            Else
                'If no division occurred, add a trailing zero
                If Len(Answer) > 0 Then
                    Answer = Answer & "0"
                    'Exception for the last number
                    If CurrDigit = Len(IBANNR) Then
                        LeftOver = CurrNumber Mod 97
                    Else
                    End If
                Else
                End If
            End If
        Next
        If LeftOver = 1 Then
            VALIDATEIBAN = ChrW(1589) & ChrW(1581) & ChrW(1740) & ChrW(1581)
        Else
            VALIDATEIBAN = ChrW(1606) & ChrW(1575) & ChrW(1583) & ChrW(1585) & ChrW(1587) & ChrW(1578)
        End If
    End If

    Exit Function

CatchError:
    VALIDATEIBAN = "ERROR: " & Err.Description

End Function