IBAN spielereien für Controls (TextBox)

[thowe]

Hallöchen,

wer öfters mit IBAN zu tun hat ist vielleicht geneigt (zumindest wir Schnitzelländer) die IBAN in 4-Zeichen-Gruppen aufzugliedern. So wird beispielsweise aus:

AT123456789012345678 -> AT12 3456 7890 1234 5678

Die Funktion(en) sind beispielsweise für Textboxen in Userformen gedacht.
Lässt sich jedoch leicht für Zellen in einer Userform umbauen

Code: Alles auswählen

'-------------------------------------------------------------
'
' purpose: removes all blank spaces in given string (Text)
'          ie: for validating or making readable IBAN
' @params: strText
' @return: String
'
'-------------------------------------------------------------


Function RemoveSpacesInString(strText) As String

    Dim intChars As Integer 'Variable: Number of Charachters in String
    
    For intChars = 1 To Len(strText)
        Select Case Mid(strText, intChars, 1)
            Case " "
            
            Case Else
            
            RemoveSpacesInString = RemoveSpacesInString & Mid(strText, intChars, 1)
            
        End Select
    Next intChars

End Function

und:

Code: Alles auswählen

'-------------------------------------------------------------
'
' purpose: makes a given Iban readable. Inserts blank space
'          after every 4 Chars (default!)
' @params: strIban, intPosition (of blank space)
' @return: String
'
'-------------------------------------------------------------

Function MakeIbanReadable(strIban, Optional intPosition) As String

    Dim intChars As Integer 'Iterator
    Dim strTempText As String 'Variable: temporarily Iban

    On Error Resume Next
    If intPosition = "" Then intPosition = 4
    
    strTempText = ""
    For intChars = 1 To Len(strIban) Step intPosition
        If strTempText = "" Then
            strTempText = Mid(strIban, intChars, intPosition)
        Else
            strTempText = Trim(strTempText) & " " & Mid(strIban, intChars, intPosition)
        End If
    Next
    MakeIbanReadable = strTempText
    
    'reset, unset, delet
    On Error GoTo 0
End Function

Kann zum Beispiel in VBA mit:

Code: Alles auswählen

MakeIbanReadable(RemoveSpacesInString("AT123456789012345678"), 4 )

aufgerufen werden

LG

[d'r Bastler]

Moin thowe,

wie Du willst nur spielen?! Dann aber richtig , denn jetzt hätte ich gerne noch eine Lösung für folgendes Thema:

IBAN in Döner-, Piroggi- und Hummus-Ländern

Dennoch lieben Dank!

[thowe]

Danke Heb,

angedacht ist schon, das auch überprüft wird ob die IBAN (inkl. Prüfzimmer) korrekt ist. Zumindest für DE und AT.
Sobald ich das fertig habe werde ich es hier posten. Das gesamte Modul modIbanHelper...

lg

[thowe]

Hallöchen,

da auch andersweitig überprüft werden soll, ob die gegebene IBAN korrekt ist, kann man beispielsweise überprüfen ob die ersten beiden Zeichen Buchstaben sind.

Code: Alles auswählen

Function IsICharacterLetter(strIban, intNumberCharacters) As Boolean
    
    Dim i As Integer 'Iterator
    Dim bytCounter As Byte 'Variable: Counter for correct Characters
    
    'initialize
    IsIbanCorrect = False
    bytCounter = 0
    
    'First check whether first two characters are Letters or not
    'only "a-z" & "A-Z"
    For i = 1 To intNumberCharacters
        If UCase(Left(strIban, i)) <> LCase(Left(strIban, i)) Then bytCounter = bytCounter + 1
    Next i
    
    If bytCounter = intNumberCharacters Then IsIbanCorrect = True
    
End Function

lg

[thowe]

Hallöchen,

Da sind beim Übertragen aus einem Projekt Typos passiert... *sorry*
Folgend der korrekt Code

Da auch anderweitig überprüft werden soll, ob die gegebene IBAN korrekt ist, kann man beispielsweise überprüfen ob die ersten beiden Zeichen Buchstaben sind...!

Code: Alles auswählen

Function IsCharacterLetter(strIban, intNumberCharacters) As Boolean
    
    Dim i As Integer 'Iterator
    Dim bytCounter As Byte 'Variable: Counter for correct Characters
    
    'initialize
    IsCharacterLetter= False
    bytCounter = 0
    
    'First check whether first two characters are Letters or not
    'only "a-z" & "A-Z"
    For i = 1 To intNumberCharacters
        If UCase(Left(strIban, i)) <> LCase(Left(strIban, i)) Then bytCounter = bytCounter + 1
    Next i
    
    If bytCounter = intNumberCharacters Then IsCharacterLetter= True
    
End Function

[d'r Bastler]

Moin IBAN-Spielkind !

Nachdem Spezialzahlen-Formate schon länger mein Hobby sind (hatte da mal eine Begegnung mit 'ner Krankenkasse, die 'ne Autonummer nicht von der Sozialversicherungsnummer unterscheiden konnte ), habe ich mich Deiner IBAN-Bastelei mal kurz auf meine Weise genähert.

Grundlage ist die Wikipedia-Liste der IBANs. Dann gibt's 'ne Userform. Man gibt ein, drückt 'nen Knopf und schon gibt's 'nen Ergebnis. Wie funktioniert's?

• Die ersten zwei Zeichen keine Großbuchstaben? Und Tschüss!!

• Die zwei Zeichen nicht in der IBAN-Tabelle? Und Tschüss!!

• Die Länge der IBAN passt nicht zur Konvention für das gefundene Land? Und Tschüss!!

• Die lokale Konvention für Buchstaben und Ziffern wird nicht erfüllt? Und Tschüss!!

Passt alles, wird aus einer ununterbrochenen Zahlenkolonne ein in 4er-Gruppen aufgeteilter String oder eben umgekehrt.

Was das Dingen nicht kann: Eine Prüfzifferberechnung. Dafür fehlen mir die Informationen zu den knapp 100 IBAN, die ich bisher verarbeite. Obwohl PZ auch so'n Hobby von mir sind

IBAN.xlsb

(29.34 KiB) Noch nie heruntergeladen

Viel Spaß damit! lg heb
Nachtrag: Bei genauerer Betrachtung der IBAN konnte ich zwei Ausreißer entdecken. Costa Rica (Grüße an Nanu!!) hätte gerne an der fünften Stelle eine Null und Island spielt gleich mit zehn undefinierten Zeichen am Ende ... Mangels Konten in den beiden Ländern, kann ich meine Bastelei diesbezüglich nicht testen. Sorry

[d'r Bastler]

Auaha, jetzt kommt's komprimiert:

Ersetzen von Leerzeichen im String:

sEingabe = Replace(sEingabe, " ", "")

Prüfen ob Stellen 1 & 2 Großbuchstaben (geht ganz sicher besser!):

'CountryCode sCC
sCC1 = Mid(sEingabe, 1, 1)
sCC2 = Mid(sEingabe, 2, 1)

'Falsche Zeichen an Stelle 1 abfangen
If Asc(sCC1) > 90 Or Asc(sCC1) < 65 Then
sMSG = "Fehler an Stelle 1"
End If

'Falsche Zeichen an Stelle 2 abfangen
If Asc(sCC2) > 90 Or Asc(sCC2) < 65 Then
sMSG = sMSG = "Fehler an Stelle 2"
End If

IBANBandwurm in IBAN Band wurm zerlegen:

For i = 1 To Len(sEingabe) Step 4
sSegment = Left(sEingabe, 4) & " "
sAusgabe = sAusgabe & sSegment
On Error Resume Next 'falls ein Segment kürzer ist als vier
sEingabe = Right(sEingabe, Len(sEingabe) - 4)
Next i
MsgBox sAusgabe

Nur so zum Spaß! lg heb