littlepete
Well-known Member
- Joined
- Mar 26, 2015
- Messages
- 507
- Office Version
- 365
- Platform
- 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
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