DUTCH foutje in macro om telefoonnummers op te maken

littlepete

Well-known Member
Joined
Mar 26, 2015
Messages
507
Office Version
  1. 365
Platform
  1. Windows
hallo,

ik heb een macro die om t even welke reeks van letters en getallen omzet naar een volwaardig BELGISCH (sorry NL) telefoonnummer.
die werkt goed, alleen: ik moet altijd twee keer de macro uitvoeren.
de eerste keer verwijdert hij alles behalve speciale tekens (/ of - of...)
de tweede keer wordt het geheel in een perfect telefoonnummer gegoten.
dus effectief door twee keer na elkaar dezelfde macro te starten...

ik zie de fout niet, over naar ... jullie !
al bedankt :) !
peter

Code:
Sub telefoon()
'
' drie stappen:
'          1. als getal dan omzetten in tekst
'          2. eerste cijfer is nul : 0 verwijderen
'          3. kijken naar de lengte van de tekst en indelen
'                    a. 0123 456789 gsm
'                    b. 012 345678   telefoon kleine zone
'                    c. 01 2345678    telefoon grote zone
'                    d. 5050              speciale nummers
'
Dim opmaaknr As String
Dim zone As String
dezetelef = ActiveCell.Value
'  alles weg behalve 0~9
For i = 1 To Len(dezetelef)
If Asc(Mid(dezetelef, i, 1)) >= Asc("0") And Asc(Mid(dezetelef, i, 1)) <= Asc("9") Then
        opmaaknr = opmaaknr + Mid(dezetelef, i, 1)
    End If
Next
'  1.: getal omzetten in tekst
If IsNumeric(dezetelef) Then
    dezetelef = CStr(dezetelef)
End If
' 2.: 0 begin tekst verwijderen
If Mid(dezetelef, 1, 1) = "0" Then
opmaaknr = Mid(dezetelef, 2)
End If
' nummer te lang
' twee cijfers: 10~19 50~89 en 42 43 92 93
' 殚n cijfer: 2 3 4 9
'
If Len(opmaaknr) > 11 Then Exit Sub
If Len(opmaaknr) > 8 Then ' gsm
    opmaaknr = Format(opmaaknr, "0" & "000 000000") ' deze lijn werkt perfect
Else
    If Len(opmaaknr) = 8 Then ' telefoon
        zone = Mid(opmaaknr, 1, 2)
        Select Case zone
        Case 10 To 19, 50 To 89, 42, 43, 92, 93
            opmaaknr = Format(opmaaknr, "000 " & "000000")
        Case 20 To 49, 90 To 99
            opmaaknr = Format(opmaaknr, "00 " & "0000000")
        End Select
    Else
        Dim wn As String
        If Len(opmaaknr) = 7 Then ' geen zonegetal wordt (...)
            opmaaknr = Format(opmaaknr, Chr(40) & Chr(133) & Chr(41) & " 0000000")
        Else
            If Len(opmaaknr) = 6 Then
                opmaaknr = Format(opmaaknr, Chr(40) & Chr(133) & Chr(41) & " 000000")
            Else
                If Len(opmaaknr) < 6 Then ' speciale nummers
                    opmaaknr = "speciaal nr.: " & dezetelef
                End If
            End If
        End If
    End If
End If
ActiveCell.Value = opmaaknr
MsgBox ("resultaat: " & opmaaknr)
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
iemand die dit kan nakijken op een fout ?
hieronder staat een verbeterde versie van de bijlage in mijn eerste bericht (dit is dus de update)
bedankt !!!

peter

Code:
Sub telefoonopmaak()
'
' drie stappen:
'          1. als getal dan omzetten in tekst
'          2. eerste cijfer is nul : 0 verwijderen
'          3. kijken naar de lengte van de tekst en indelen
'                    a. 0123 456789 gsm
'                    b. 012 345678   telefoon kleine zone
'                    c. 01 2345678    telefoon grote zone
'                    d. 5050              speciale nummers
'
Dim i As Integer
Dim opmaaknr As String
Dim dezetelef As String
Dim zone As String
dezetelef = ActiveCell.Value
If Len(dezetelef) = 0 Then Exit Sub
For i = 1 To Len(dezetelef)
If Asc(Mid(dezetelef, i, 1)) >= Asc("0") And Asc(Mid(dezetelef, i, 1)) <= Asc("9") Then
        opmaaknr = opmaaknr + Mid(dezetelef, i, 1)
    End If
Next
' 2.: 0 begin tekst verwijderen
If Mid(opmaaknr, 1, 1) = "0" Or 0 Or CStr(0) Then
opmaaknr = Mid(opmaaknr, 2, Len(opmaaknr))
End If
'  1.: getal omzetten in tekst
If IsNumeric(opmaaknr) Then
    opmaaknr = CStr(opmaaknr)
End If
'
' nummer te lang
' twee cijfers: 10~19 50~89 en 42 43 92 93
' één cijfer: 2 3 4 9
'
If Len(opmaaknr) > 11 Then
MsgBox ("dit antwoord is te lang")
Exit Sub
End If
If Len(opmaaknr) > 8 Then ' gsm
    opmaaknr = Format(opmaaknr, "0" & "000 000000") ' deze lijn werkt perfect
Else
    If Len(opmaaknr) = 8 Then ' telefoon
        zone = Mid(opmaaknr, 1, 2)
        Select Case zone
        Case 10 To 19, 50 To 89, 42, 43, 92, 93
            opmaaknr = Format(opmaaknr, "000 " & "000000")
        Case 20 To 49, 90 To 99
            opmaaknr = Format(opmaaknr, "00 " & "0000000")
        End Select
    Else
        Dim wn As String
        If Len(opmaaknr) = 7 Then ' geen zonegetal wordt (...)
            opmaaknr = Format(opmaaknr, Chr(40) & Chr(133) & Chr(41) & " 0000000")
        Else
            If Len(opmaaknr) = 6 Then
                opmaaknr = Format(opmaaknr, Chr(40) & Chr(133) & Chr(41) & " 000000")
            Else
                If Len(opmaaknr) < 6 Then ' speciale nummers
                    opmaaknr = "speciaal nr.: " & dezetelef
                End If
            End If
        End If
    End If
End If
ActiveCell.Value = opmaaknr
End Sub
 
Last edited:
Upvote 0
THis is not going to help you at all, but I just had to add this,,,

Ek kom van Suid Afrika (bly nou in Amerika), en wat en nou tik/praat is afrikaans. Ek kan min of meer presies verstaan wat jy bo gese het, en ek sien that flaamse (Flemish?) is baie nayby aan Afrikaans, dit ley amper as of jy Afrikaans preet, maar dat jy nie bair goed kan spel nie lol.

Ek wonder of jy die ook kan lees?
(can you read this too?)
 
Upvote 0
ek is dialect aan de kust in belgie :) wij kunnen inderdaad alles verstaan, met uitzondering van "inheemse" afrikaanse woorden die bij ons niet bestaan... de y wordt bij ons altijd ij geschreven... we kunnen elkaar verstaan en toch zo ver van elkaar ! je kan me altijd zoeken op facebook ;) nog een hele (baie) mooie avond (aand?) lol ...
 
Upvote 0
Nog iets anders is die gramatiek (the grammer), maar ek kan you nog steed verstaan vir die meeste part :)
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top