OVH Cloud OVH Cloud

Extraine chaine numéro de téléphone???

9 réponses
Avatar
Fg
Bonjour,
Question de Newbie...
J'ai en Col A des données adresses , codes postaux et téléphones.
J'aimerais avec une Macro extraire uniquement le numéro de téléphone de
format ## ## ## ## ## et le déplacer en colonne E sur la même ligne???
Merci d'avance

9 réponses

Avatar
Elliac
Bonjour,

der = Range("a50000").End(xlUp).Row
Range("E1:E" & der) = "=Right(RC[-4],10)"

Remplacer 10 par 14 s'il y a des espaces dans les n° de téléphone.

Camille

"Fg" wrote:

Bonjour,
Question de Newbie...
J'ai en Col A des données adresses , codes postaux et téléphones.
J'aimerais avec une Macro extraire uniquement le numéro de téléphone de
format ## ## ## ## ## et le déplacer en colonne E sur la même ligne???
Merci d'avance





Avatar
Philippe Noss
Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html
Avatar
Fg
J'ai testé ....mais ça ne fonctionne pas
J'ai mis en A1 une cellule au format catégorie spéciale Téléphone et j'ai
remplacé Ax en A1 donc. la macro se déroule bien mais rien ne se passe...je
n'ai pas d'extraction du numéro de téléphone en Offset (0,4)
Voilà un exemple des lignes contenues en ColA

10 rue Moulin 75000 PARIS 01 85 76 85 54
58 rue Jaures 75000 PARIS
86 Bld Leclerc 01 78 41 40 54 75000 PARIS
etc...
Je ne vois pas le problème!!!


"Philippe Noss" a écrit dans le message de news:

Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html
Avatar
Philippe Noss
Si je lis bien le 2 eme message, la cellule contient par exemple "10
rue Moulin 75000 PARIS 01 85 76 85 54
" . Dans ce cas la cellule n'est certainement pas formaté avec une
format de type numero de telephone !

Et il s'agit donc d'extraire le num de telephone d'une chaine de
caractère.
Cela me parait pas evident de reconnaitre un numéro de tel dans une
chaine de caractère...
il faudrait eventuellement m'envoyer le fichier....
Avatar
SL
Bonjour

Suivant la forme de tes données, voici ce que je propose :
en A1:Ax : tes adresses
en B1
=STXT(A1;EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)
en matricielle (à valider par CTRL +MAJ+ ENTREE)

puis copier B1 jusqu'en Bx
Donnera #NA pour 58 rue Jaures 75000 PARIS car pas de n° de téléphone

Explications :
http://cjoint.com/?kgpnVs2D8s

Une restriction cependant : s'il y a un chiffre avant le n° de téléphone
10 rue Jean23 01 52 ...
ou ...PARIS Cedex05 01 42 00 00 00.

Stéphane



"Fg" a écrit dans le message de news:
43451973$0$11767$
J'ai testé ....mais ça ne fonctionne pas
J'ai mis en A1 une cellule au format catégorie spéciale Téléphone et j'ai
remplacé Ax en A1 donc. la macro se déroule bien mais rien ne se
passe...je n'ai pas d'extraction du numéro de téléphone en Offset (0,4)
Voilà un exemple des lignes contenues en ColA

10 rue Moulin 75000 PARIS 01 85 76 85 54
58 rue Jaures 75000 PARIS
86 Bld Leclerc 01 78 41 40 54 75000 PARIS
etc...
Je ne vois pas le problème!!!


"Philippe Noss" a écrit dans le message de news:

Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html




Avatar
SL
Re-
Un petit soucis dans mon tableau du au fait que j'ai remplacé les espaces
entre PARIS et le n° de téléphone par des espace dans Excel
10 rue Moulin 75000 PARIS 01 85 76 85 54


En effet, recopiez la ligne ce-dessus et faites :
=SUBSTITUE(A1;" ";)
les espaces entre PARIS et 01 ne sont pas considérés comme des " "
10rueMoulin75000PARIS 0185768554

il te faudra donc adapter la formule suivant ton fichier.

Stéphane

"SL" a écrit dans le message de news:

Bonjour

Suivant la forme de tes données, voici ce que je propose :
en A1:Ax : tes adresses
en B1
=STXT(A1;EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)
en matricielle (à valider par CTRL +MAJ+ ENTREE)

puis copier B1 jusqu'en Bx
Donnera #NA pour 58 rue Jaures 75000 PARIS car pas de n° de téléphone

Explications :
http://cjoint.com/?kgpnVs2D8s

Une restriction cependant : s'il y a un chiffre avant le n° de téléphone
10 rue Jean23 01 52 ...
ou ...PARIS Cedex05 01 42 00 00 00.

Stéphane



"Fg" a écrit dans le message de news:
43451973$0$11767$
J'ai testé ....mais ça ne fonctionne pas
J'ai mis en A1 une cellule au format catégorie spéciale Téléphone et j'ai
remplacé Ax en A1 donc. la macro se déroule bien mais rien ne se
passe...je n'ai pas d'extraction du numéro de téléphone en Offset (0,4)
Voilà un exemple des lignes contenues en ColA

10 rue Moulin 75000 PARIS 01 85 76 85 54
58 rue Jaures 75000 PARIS
86 Bld Leclerc 01 78 41 40 54 75000 PARIS
etc...
Je ne vois pas le problème!!!


"Philippe Noss" a écrit dans le message de news:

Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html








Avatar
Philippe Noss
Bravo !!!!
Avec mes formules matricielles je n'y arriverai jamiais !
J'aurais plutot fait une macro avec Split...mais pas le temps !
juste une remarque, si on passe un SUPPRESPACE dans les champs avant on
a plus le problème
=STXT(SUPPRESPACE(A1);EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(SUPPRESPACE(A1);L IGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)
'a valider avec ctl alt entrée
Avatar
Fg
Effectivement j'ai testé...ça fonctionne mais pas complètement!
J'ai des numéros de téléphone tronqués...il manque les derniers
chiffres...même problème qu'avec le fichier joint!!!
Je doit sauvegarder aussi ma Col d'origine pour récupérer les
adresses...avec espace!! ;)
Merci tout de même

"SL" a écrit dans le message de news:
%
Re-
Un petit soucis dans mon tableau du au fait que j'ai remplacé les espaces
entre PARIS et le n° de téléphone par des espace dans Excel
10 rue Moulin 75000 PARIS 01 85 76 85 54


En effet, recopiez la ligne ce-dessus et faites :
=SUBSTITUE(A1;" ";)
les espaces entre PARIS et 01 ne sont pas considérés comme des " "
10rueMoulin75000PARIS 0185768554

il te faudra donc adapter la formule suivant ton fichier.

Stéphane

"SL" a écrit dans le message de news:

Bonjour

Suivant la forme de tes données, voici ce que je propose :
en A1:Ax : tes adresses
en B1
=STXT(A1;EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)
en matricielle (à valider par CTRL +MAJ+ ENTREE)

puis copier B1 jusqu'en Bx
Donnera #NA pour 58 rue Jaures 75000 PARIS car pas de n° de téléphone

Explications :
http://cjoint.com/?kgpnVs2D8s

Une restriction cependant : s'il y a un chiffre avant le n° de téléphone
10 rue Jean23 01 52 ...
ou ...PARIS Cedex05 01 42 00 00 00.

Stéphane



"Fg" a écrit dans le message de news:
43451973$0$11767$
J'ai testé ....mais ça ne fonctionne pas
J'ai mis en A1 une cellule au format catégorie spéciale Téléphone et
j'ai remplacé Ax en A1 donc. la macro se déroule bien mais rien ne se
passe...je n'ai pas d'extraction du numéro de téléphone en Offset (0,4)
Voilà un exemple des lignes contenues en ColA

10 rue Moulin 75000 PARIS 01 85 76 85 54
58 rue Jaures 75000 PARIS
86 Bld Leclerc 01 78 41 40 54 75000 PARIS
etc...
Je ne vois pas le problème!!!


"Philippe Noss" a écrit dans le message de news:

Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html












Avatar
SL
Exact, Philippe a complété la réponse avec SUPPRESPACE(A1)
=STXT(SUPPRESPACE(A1);EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(SUPPRESPACE(A1);LIGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)

Je doit sauvegarder aussi ma Col d'origine pour récupérer les
adresses...avec espace!! ;)
Aucun problème.

Tu copies la formule en B et en A tu gardes ton texte initial.

Au passage en C pour récupérer l'adresse sans téléphone, =SUBSTITUE(A1;B1;)

Tu peux mettre un extrait (non confidentiel) de ton fichier sur
www.cjoint.com si tu as encore des soucis.

Stéphane

"Fg" a écrit dans le message de news:
43453a6e$0$11752$
Effectivement j'ai testé...ça fonctionne mais pas complètement!
J'ai des numéros de téléphone tronqués...il manque les derniers
chiffres...même problème qu'avec le fichier joint!!!
Je doit sauvegarder aussi ma Col d'origine pour récupérer les
adresses...avec espace!! ;)
Merci tout de même

"SL" a écrit dans le message de news:
%
Re-
Un petit soucis dans mon tableau du au fait que j'ai remplacé les espaces
entre PARIS et le n° de téléphone par des espace dans Excel
10 rue Moulin 75000 PARIS 01 85 76 85 54


En effet, recopiez la ligne ce-dessus et faites :
=SUBSTITUE(A1;" ";)
les espaces entre PARIS et 01 ne sont pas considérés comme des " "
10rueMoulin75000PARIS 0185768554

il te faudra donc adapter la formule suivant ton fichier.

Stéphane

"SL" a écrit dans le message de news:

Bonjour

Suivant la forme de tes données, voici ce que je propose :
en A1:Ax : tes adresses
en B1
=STXT(A1;EQUIV(1;1*ESTNUM(1*SUBSTITUE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)-14));14);"
";""));0)+1;14)
en matricielle (à valider par CTRL +MAJ+ ENTREE)

puis copier B1 jusqu'en Bx
Donnera #NA pour 58 rue Jaures 75000 PARIS car pas de n° de téléphone

Explications :
http://cjoint.com/?kgpnVs2D8s

Une restriction cependant : s'il y a un chiffre avant le n° de téléphone
10 rue Jean23 01 52 ...
ou ...PARIS Cedex05 01 42 00 00 00.

Stéphane



"Fg" a écrit dans le message de news:
43451973$0$11767$
J'ai testé ....mais ça ne fonctionne pas
J'ai mis en A1 une cellule au format catégorie spéciale Téléphone et
j'ai remplacé Ax en A1 donc. la macro se déroule bien mais rien ne se
passe...je n'ai pas d'extraction du numéro de téléphone en Offset (0,4)
Voilà un exemple des lignes contenues en ColA

10 rue Moulin 75000 PARIS 01 85 76 85 54
58 rue Jaures 75000 PARIS
86 Bld Leclerc 01 78 41 40 54 75000 PARIS
etc...
Je ne vois pas le problème!!!


"Philippe Noss" a écrit dans le message de news:

Bonjour,
Une soltion avec ce code...
Cet macro copie les cellules de la plage active dans la cellule situé
4 colonne à droite, en fonction du format contenu dans la cellule Ax.
Attention, remplacer Ax par l'adresse de la cellule contenant le format
référence.

Sub copierTel()
For Each C In Selection
If Range(C.Address).NumberFormat = Range("Ax").NumberFormat Then
C.Copy
ActiveSheet.Paste Destination:¬tiveSheet.Range(C.Offset(0,
4).Address)
End If
Next
End Sub

Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html