VBA: code om formaat IBAN toe te passen op bereik

[tomswaelen]

Met behulp van dit forum heb ik voor een andere Excel deze code al eens verkregen:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo oeps
    If Target.Range <> "Sjabloon verdeling.xlsm!Rekeningnummers" Then Exit Sub
'    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    With Target
        .Value = Replace(.Value, " ", "")
        .Value = Replace(.Value, "be", "BE")
        .Value = Mid(.Value, 1, 4) & " " & Mid(.Value, 5, 4) & " " & Mid(.Value, 9, 4) & " " & Mid(.Value, 13, 4) & " " & Mid(.Value, 17, 4) & " " & Mid(.Value, 21, 4)
    End With
oeps:
    Application.EnableEvents = True
End Sub

Nu ben ik met een andere Excel bezig die ook met rekeningnummers werkt. De werking zou echter iets anders moeten zijn:

- deze keer werk ik met een bereik dat "Rekeningnummers" heet
- de code zou alles in groepjes van 4, te beginnen van voren moeten zetten. Een IBAN kan maximaal 34 tekens hebben.
- de code zou alles in uppercase moeten zetten (mijn vorige Excel werkte enkel met Belgische rekeningnummers, mijn huidige ook met internationale)

(de validatie van het nummer zelf gebeurt via een andere functie)

Ik heb echter geen idee hoe ik hieraan moet beginnen.

Ik heb al eens geprobeerd om bovenstaande code aan te passen zodat deze met mijn bereik werkt, maar zelfs dat lukt me niet:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo oeps
    If Target.Address <> Range("Rekeningnummers").Address Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    With Target
        .Value = Replace(.Value, " ", "")
        .Value = Replace(.Value, "be", "BE")
        .Value = Mid(.Value, 1, 4) & " " & Mid(.Value, 5, 4) & " " & Mid(.Value, 9, 4) & " " & Mid(.Value, 13, 4) & " " & Mid(.Value, 17, 4) & " " & Mid(.Value, 21, 4)
    End With
oeps:
    Application.EnableEvents = True
End Sub

 

[edmoor]

Maak er een user defined function (UDF) van. Dat is veel eenvoudiger voor hergebruik.
Maak tevens gebruik van regeloverloop voor een betere leesbaarheid.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> Range("Rekeningnummers").Address Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    [COLOR="#008000"]'Target.Value is bijvoorbeeld: nl05rabo1234123400[/COLOR]
    On Error Resume Next
    Target.Value = Rekening(Target.Value)
    Application.EnableEvents = True
End Sub

Function Rekening(Nummer As String) As String
    If Len(Nummer) < 34 Then Nummer = Nummer & Left("00000000000000", 34 - Len(Nummer))
    Rekening = UCase(Nummer)
    Rekening = Replace(Rekening, " ", "")
    Rekening = Mid(Rekening, 1, 4) & " " & _
               Mid(Rekening, 5, 4) & " " & _
               Mid(Rekening, 9, 4) & " " & _
               Mid(Rekening, 13, 4) & " " & _
               Mid(Rekening, 17, 4) & " " & _
               Mid(Rekening, 21, 4) & " " & _
               Mid(Rekening, 25, 4) & " " & _
               Mid(Rekening, 29, 4)
End Function

Resultaat van bovenstaande is:
NL05 RABO 1234 1234 0000 0000 0000 0000

 

[snb]

of met:

Function f_snb(c00)
    f_snb = Format(c00 & String(4 - Len(c00) Mod 4, "0"), Replace(Space(Len(c00) \ 4), " ", "@@@@ "))
End Function

 

[tomswaelen]

Ik heb het function-gedeelte in een aparte module geplakt in de VBE, en dan het Sub-gedeelte in de code van het werkblad in VBA. Er gebeurt echter niets. Ook deze code volledig in het werkblad in de VBE plakken, doet niets.

Voor alle duidelijkheid, de bedoeling is dat, als een user bv. nl05Rabo1234123412 in een cel uit het bereik typt, dat de code hier NL05 RABO 1234 1234 12 van maakt zodra hij de cel verlaat.

 

[edmoor]

Dan heb je iets niet goed gedaan want het werkt prima. Plaats een voorbeeld documentje.

 

[tomswaelen]

Ik heb het nu even in een nieuw document gedaan, zodat ik zeker ben dat mijn andere code de boel niet vervuilt. Ook hier doet de code niets. Wat doe ik fout?

In mijn oorspronkelijk bestand bevat het bereik Rekeningnummers samengevoegde cellen, maar ik vermoed dat dat niets uitmaakt...?

Regeloverloop in mijn oorspronkelijk bestand is trouwens niet nodig; mijn cellen zijn breed genoeg voor eender welk rekeningnummer.

Bekijk bijlage Map1.xlsm

 

[edmoor]

Wat betreft regeloverloop had ik het over de VBA code zelf.

Wijzig in je Sub deze regel:
If Target.Address <> Range("Rekeningnummers").Address Then Exit Sub
In
If Intersect(Target, Range("Rekeningnummers")) Is Nothing Then Exit Sub

 

[tomswaelen]

Erg vreemd, maar hij doet nog steeds helemaal niets. Kan je misschien even zelf een voorbeelddocumentje uploaden?

 

[edmoor]

Doet het hier prima in het documentje dat je plaatste met alleen de wijziging die ik voorstelde.
Bekijk bijlage map1.xlsm

 

[tomswaelen]

Inderdaad, die werkt bij mij ook...

Ik merk hierbij wel dat, als ik een Belgische IBAN (bijvoorbeeld BE11 4050 5046 1148) invoer, hij er een hoop nulletjes achter zet. Dat is niet de bedoeling, want dan klopt het rekeningnummer zelf ook niet meer.

De bedoeling zou zijn dat hij de string opdeelt in groepjes van 4, en de rest (als die er is, als de lengte van de string dus niet deelbaar is door 4) laat voor wat het is:

https://nl.wikipedia.org/wiki/International_Bank_Account_Number#Landspecifieke_regels

Ik heb overigens ook al zitten googlen (er is echt wel een vraag naar IBAN-celopmaak voor Excel), maar die resultaten krijg ik ook niet aan de slag.

 

[edmoor]

IK heb er 34 van gemaakt omdat je dat noemde. Als je naar de functie kijkt zie je dat je dat eenvoudig kan inkorten.

 

[tomswaelen]

Ja, maar dat zei ik gewoon omdat een IBAN maximaal 34 karakters kan bevatten. Het is niet de bedoeling dat er cijfers worden bijgevoegd. Dat deel van de code zie ik inderdaad duidelijk staan.

Eigenlijk zou de code gewoon dit moeten doen:

- alles omzetten in uppercase (voor de landcode)
- alle spaties uit de string halen (lijkt me het beste zodat je altijd met dezelfde basis start), en tot slot
- vanaf het begin van de string de string opdelen in groepjes van 4, met eventueel aan het einde het overschot

 

[HSV]

Hier ook nog eentje.
Zelf het bereik even aanpassen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, y As Long, check As Boolean
If Not Intersect(Target, Range("a1:a11")) Is Nothing And Target.Count = 1 Then
 With CreateObject("vbscript.regexp")
            .ignorecase = True
            .Pattern = "^[A-Z]{2}[0-9]{2}[A-Z]{4}[0-9]"
               check = .test(Target.Value)
        End With
 Application.EnableEvents = False
 If check Then
      For i = 5 To Len(Target) Step 4
         Target.Characters(i + y, 0).Insert (" ")
         y = y + 1
       Next i
    Else
         MsgBox "Verkeerde invoer;" & vbLf & vbLf & _
           "Dit moet zijn:  2 letters gevolgd door 2 cijfers, daarna 4 letters en voor de rest cijfers.", vbInformation, "Let op"
        Application.Undo
    End If
    Target = UCase(Target)
   Application.EnableEvents = True
 End If
End Sub

 

[edmoor]

@snb:
Ik heb die van jou gebruikt en werkt op zich prima, maar ik hou aan het einde een 0000 teveel over.
Dus: be11405050461148 wordt BE11 4050 5046 1148 0000
Kan je daar nog iets aan doen?

Function Rekening(Nummer) As String
    Nummer = UCase(Replace(Nummer, " ", ""))
    Rekening = Format(Nummer & String(4 - Len(Nummer) Mod 4, "0"), Replace(Space(Len(Nummer) \ 4), " ", "@@@@ "))
End Function

 

[tomswaelen]

@HSV, als ik jouw code goed begrijp werkt deze enkel voor Nederlandse IBAN's. Voor Belgische IBAN's zijn plaatsen 4-8 bijvoorbeeld geen letters.

Zoals ik al zei, eigenlijk zou de code gewoon dit moeten doen:

1. alles omzetten in uppercase (voor de landcode)
2. alle spaties uit de string halen (lijkt me het beste zodat je altijd met dezelfde basis start), en tot slot
3. vanaf het begin van de string de string opdelen in groepjes van 4, met eventueel aan het einde het overschot


Algemeen gesproken vind ik het wel redelijk frappant dat Excel deze functie niet standaard heeft. Het is nu niet alsof een IBAN iets obscuur is he

 

[HSV]

In de herkansing.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, y As Long
If Not Intersect(Target, Range("a1:a11")) Is Nothing And Target.Count = 1 Then
 Application.EnableEvents = False
      For i = 1 To Len(Target) Step 4
         Target.Characters(i + y, 0).Insert (" ")
         y = y + 1
       Next i
    Target = UCase(Target)
   Application.EnableEvents = True
 End If
End Sub

 

[tomswaelen]

@HSV:

Die doet het inderdaad. Alleen werkt dit alleen als je de string ingeeft zonder spaties. Als je de string correct ingeeft (dus in groepjes van 4) is het eindresultaat niet correct, omdat hij jouw functie alsnog toepast. Dus ik denk dat er best wordt ingebouwd dat hij telkens de spaties verwijderd, zodat je telkens dezelfde basis hebt.

Als je de string zonder spaties invoert, zie ik dat hij aan het begin van de string ook een spatie invoert. Dat zou eigenlijk ook niet mogen.

Ik vrees dat ik voor de rest je code niet echt begrijp Ik maak er wel uit op dat ze werkt met een loop-functie.

 

[edmoor]

Zet er dan net na Application.EnableEvents = False dit in:
Target = Replace(Target, " ", "")

 

[tomswaelen]

Zet er dan net na Application.EnableEvents = False dit in:
Target = Replace(Target, " ", "")

Dat doet het hem, bedankt!

Alleen zie ik dat hij nog steeds een spatie invoert aan het begin van het resultaat. Hoe komt dit? Ik vrees dat ik te weinig begrijp van je code om zelf te zien waarom hij dit doet.

 

[edmoor]

Dan kan je dit:
Target = UCase(Target)

Nog wijzigen:
Target = Mid(UCase(Target),2)