XL 2016 Typologie de contacts

didcac · 8 Novembre 2021

Bonjour à tous,
J'aimerais pouvoir dispatcher des numéros et téléphone et courriels contenus dans une seule colonne A, selon le genre : mobile, domicile, courriel, etc, dans une seule colonne B.
L'idée serait donc d'avoir des critères du style :

• Si la donnée commence par "06" ou "07" : écrire "Mobile"
• Si la donnée finit par "00" : écrire "Standard"
• Si la donnée contient "STD" ou "std" : écrire "Standard"
• Si la donnée contient "fax" ou "Fax" : écrire "Télécopie"
• Si la donnée contient "dom" ou "Dom" ou Domic" ou "domic" : écrire "Domicile"
• Si la donnée contient "LD" : écrire "Ligne directe"
• Si la donnée contient "perso" : écrire "Mobile perso" (ici, cela peut écraser les Mobiles non spécifiés via "06 ou 07" vu ci-avant en 1er critère, et c'est OK)
• Si la donnée contient "pro" : écrire "Mobile pro"
• Si la donnée contient "LDCE" ou LD CE" ou "CE" : écrire "Local CE"
• Si la donnée contient "@" : écrire "Courriel"
• Si la donnée contient "@ & perso" : écrire "Courriel perso"
• dans tous les autres cas de figure, écrire : "Travail"
(écriture à faire sans les guillemets)

En guise d'exemples, même si c'est assez simple à comprendre, je pense :
07 21 15 45 12 donnerait : Mobile
02 44 56 28 74 dom donnerait : Domicile
perso des@ghj.eu donnerait : Courriel perso
05 57 45 56 03 donnerait : Travail (puisqu'aucun critère en particulier)

J'ai créé un fichier en PJ couvrant l'ensemble des cas de figure (pour Test)

Merci de votre aimable aide !
Bien cordialement

Bernard_XLD · 8 Novembre 2021

re,

sinon, il suffit de gérer minuscules et majuscules dans la fonction.
[édition, modification du code, en variabilisant Cel_Ref en minuscule, la fonction sera plus rapide]

Bien cordialement, @+

VB:

Function Type_Contact$(ByVal Cel_Ref$)
If Cel_Ref = "" Then Type_Contact = "": Exit Function
Dim LCel_Ref$
LCel_Ref = LCase(Cel_Ref)
If InStr(1, LCel_Ref, "std") Then Type_Contact = "Standard": Exit Function
If InStr(1, LCel_Ref, "fax") Then Type_Contact = "Télécopie": Exit Function
If InStr(1, LCel_Ref, "dom") Then Type_Contact = "Domicile": Exit Function
If InStr(1, LCel_Ref, "perso") > 0 And InStr(1, Cel_Ref, "@") > 0 Then Type_Contact = "Courriel perso": Exit Function
If InStr(1, LCel_Ref, "perso") Then Type_Contact =...

JHA · 8 Novembre 2021

Bonjour à tous,

Il y a beaucoup de cas différents, je pense qu'il faut passer par VBA mais je suis incapable de le faire.
Un début de piste avec des si() mais c'est assez galère.
j'ai isolé les numéros de téléphone

JHA

sylvanu · 8 Novembre 2021

Bonjour Didcac,
Une solution en PJ, en attendant peut être plus subtil :

VB:

=SIERREUR(
SI(GAUCHE(A3;2)="06";"Mobile";
SI(GAUCHE(A3;2)="07";"Mobile perso";
SI(GAUCHE(A3;2)="03";"Domicile";
SI(GAUCHE(A3;3)="LD ";"Ligne directe";
SI(GAUCHE(A3;3)="pro";"Mobile pro";
SI(GAUCHE(A3;3)="Sce";"Service";
SI(GAUCHE(A3;4)="LDCE";"Local CE";
SI(GAUCHE(A3;3)="fax";"Télécopie";
SI(ET(GAUCHE(A3;5)="perso";NB.SI(A3;"*@*")=0);"Mobile perso";
SI(ET(GAUCHE(A3;5)="perso";NB.SI(A3;"*@*")=1);"Courriel perso";
SI(NB.SI(A3;"*std*")=1;"Standard";
"Travail")))))))))));"")

Il existe plus simple si vous acceptez quelque part d'avoir une liste de correspondance.

Bernard_XLD · 8 Novembre 2021

Bonjour Didcac, JHA, sylvanu, le forum

Une proposition de fonction personnalisée.

Bien cordialement, @+

VB:

Option Compare Text
Function Type_Contact$(ByVal Cel_Ref$)
If Cel_Ref = "" Then Type_Contact = "": Exit Function
If InStr(1, Cel_Ref, "std") Then Type_Contact = "Standard": Exit Function
If InStr(1, Cel_Ref, "fax") Then Type_Contact = "Télécopie": Exit Function
If InStr(1, Cel_Ref, "dom") Then Type_Contact = "Domicile": Exit Function
If InStr(1, Cel_Ref, "perso") > 0 And InStr(1, Cel_Ref, "@") > 0 Then Type_Contact = "Courriel perso": Exit Function
If InStr(1, Cel_Ref, "perso") Then Type_Contact = "Mobile perso": Exit Function
If InStr(1, Cel_Ref, "@") Then Type_Contact = "Courriel": Exit Function
If InStr(1, Cel_Ref, "pro") Then Type_Contact = "Mobile pro": Exit Function
If InStr(1, Cel_Ref, "sce") Then Type_Contact = "Service": Exit Function
If InStr(1, Cel_Ref, "ce") Then Type_Contact = "Local CE": Exit Function
If InStr(1, Cel_Ref, "ld") Then Type_Contact = "Ligne directe": Exit Function
If Right(Cel_Ref, 2) = "00" Then Type_Contact = "Standard": Exit Function
If Left(Cel_Ref, 2) = "06" Or Left(Cel_Ref, 2) = "07" Then Type_Contact = "Mobile": Exit Function
Type_Contact = "Travail"
End Function

didcac · 8 Novembre 2021

Yeahou à dit:

Bonjour Didcac, JHA, sylvanu, le forum

Une proposition de fonction personnalisée.

Bien cordialement, @+

VB:

Option Compare Text
Function Type_Contact$(ByVal Cel_Ref$)
If Cel_Ref = "" Then Type_Contact = "": Exit Function
If InStr(1, Cel_Ref, "std") Then Type_Contact = "Standard": Exit Function
If InStr(1, Cel_Ref, "fax") Then Type_Contact = "Télécopie": Exit Function
If InStr(1, Cel_Ref, "dom") Then Type_Contact = "Domicile": Exit Function
If InStr(1, Cel_Ref, "perso") > 0 And InStr(1, Cel_Ref, "@") > 0 Then Type_Contact = "Courriel perso": Exit Function
If InStr(1, Cel_Ref, "perso") Then Type_Contact = "Mobile perso": Exit Function
If InStr(1, Cel_Ref, "@") Then Type_Contact = "Courriel": Exit Function
If InStr(1, Cel_Ref, "pro") Then Type_Contact = "Mobile pro": Exit Function
If InStr(1, Cel_Ref, "sce") Then Type_Contact = "Service": Exit Function
If InStr(1, Cel_Ref, "ce") Then Type_Contact = "Local CE": Exit Function
If InStr(1, Cel_Ref, "ld") Then Type_Contact = "Ligne directe": Exit Function
If Right(Cel_Ref, 2) = "00" Then Type_Contact = "Standard": Exit Function
If Left(Cel_Ref, 2) = "06" Or Left(Cel_Ref, 2) = "07" Then Type_Contact = "Mobile": Exit Function
Type_Contact = "Travail"
End Function

Bonsoir Yeahou,
Merci beaucoup pour ce programme qui marche très bien avec la vraie Base appliquée.
Il y a juste quelques petits soucis liés à des choses que je n'avais pas anticipées, comme par exemple parfois la présence du mot Agence qui génère "Local CE" car il contient (à la fin) "ce". Et d'autres mots pareils.

Ainsi, voici les petites améliorations à apporter, si possible :

1) imposer les majuscules pour : "CE" ou "LD CE" ou "LDCE"

2) imposer les majuscules pour "LD"

Merci.

didcac · 8 Novembre 2021

JHA à dit:
Bonjour à tous,

Il y a beaucoup de cas différents, je pense qu'il faut passer par VBA mais je suis incapable de le faire.
Un début de piste avec des si() mais c'est assez galère.
j'ai isolé les numéros de téléphone

JHA

Bonsoir JHA,
Merci également pour ce programme qui marche très bien avec la vraie Base appliquée.
Là aussi, le résultat est similaire à Yeahou, avec les 2 petits changements évoqués (forçage de Majuscules).
Chez vous, il y a un souci de plus : quand il y a "Fax perso" (que je n'avais pas envisagé initialement, il est vrai...), cela génère la réponse "mobile perso"...

Merci.

Bernard_XLD · 8 Novembre 2021

re,

didcac à dit:
Bonsoir Yeahou,
Merci beaucoup pour ce programme qui marche très bien avec la vraie Base appliquée.
Il y a juste quelques petits soucis liés à des choses que je n'avais pas anticipées, comme par exemple parfois la présence du mot Agence qui génère "Local CE" car il contient (à la fin) "ce". Et d'autres mots pareils.

Ainsi, voici les petites améliorations à apporter, si possible :

1) imposer les majuscules pour : "CE" ou "LD CE" ou "LDCE"

2) imposer les majuscules pour "LD"

Pas besoin, il suffit de mettre dans l'ordre pour que ce soit traité correctement.
Quand une valeur est rencontrée, on sort de la fonction, c'était déjà le problème entre ld, ldce, ld ce et ce, c'est pour cela que ce est traité avant ld.

Bien cordialement, @

VB:

Option Compare Text
Function Type_Contact$(ByVal Cel_Ref$)
If Cel_Ref = "" Then Type_Contact = "": Exit Function
If InStr(1, Cel_Ref, "agence") Then Type_Contact = "Agence": Exit Function
If InStr(1, Cel_Ref, "std") Then Type_Contact = "Standard": Exit Function
If InStr(1, Cel_Ref, "fax") Then Type_Contact = "Télécopie": Exit Function
If InStr(1, Cel_Ref, "dom") Then Type_Contact = "Domicile": Exit Function
If InStr(1, Cel_Ref, "perso") > 0 And InStr(1, Cel_Ref, "@") > 0 Then Type_Contact = "Courriel perso": Exit Function
If InStr(1, Cel_Ref, "perso") Then Type_Contact = "Mobile perso": Exit Function
If InStr(1, Cel_Ref, "@") Then Type_Contact = "Courriel": Exit Function
If InStr(1, Cel_Ref, "pro") Then Type_Contact = "Mobile pro": Exit Function
If InStr(1, Cel_Ref, "sce") Then Type_Contact = "Service": Exit Function
If InStr(1, Cel_Ref, "ce") Then Type_Contact = "Local CE": Exit Function
If InStr(1, Cel_Ref, "ld") Then Type_Contact = "Ligne directe": Exit Function
If Right(Cel_Ref, 2) = "00" Then Type_Contact = "Standard": Exit Function
If Left(Cel_Ref, 2) = "06" Or Left(Cel_Ref, 2) = "07" Then Type_Contact = "Mobile": Exit Function
Type_Contact = "Travail"
End Function

didcac · 8 Novembre 2021

sylvanu à dit:

Bonjour Didcac,
Une solution en PJ, en attendant peut être plus subtil :

VB:

=SIERREUR(
SI(GAUCHE(A3;2)="06";"Mobile";
SI(GAUCHE(A3;2)="07";"Mobile perso";
SI(GAUCHE(A3;2)="03";"Domicile";
SI(GAUCHE(A3;3)="LD ";"Ligne directe";
SI(GAUCHE(A3;3)="pro";"Mobile pro";
SI(GAUCHE(A3;3)="Sce";"Service";
SI(GAUCHE(A3;4)="LDCE";"Local CE";
SI(GAUCHE(A3;3)="fax";"Télécopie";
SI(ET(GAUCHE(A3;5)="perso";NB.SI(A3;"*@*")=0);"Mobile perso";
SI(ET(GAUCHE(A3;5)="perso";NB.SI(A3;"*@*")=1);"Courriel perso";
SI(NB.SI(A3;"*std*")=1;"Standard";
"Travail")))))))))));"")

Il existe plus simple si vous acceptez quelque part d'avoir une liste de correspondance.

Bonsoir sylvanu,
Merci aussi pour votre aimable contribution. Mais votre formule, marchant très bien pour les petits exemples de Test, a pas mal d'erreurs avec la vraie Base. Cela renvoie souvent "Travail", alors qu'il y a un @ dedans...
Mais les 2 autres solutions sont très satisfaisantes.
Merci, quoi qu'il en soit.

Bernard_XLD · 8 Novembre 2021

re,

sinon, il suffit de gérer minuscules et majuscules dans la fonction.
[édition, modification du code, en variabilisant Cel_Ref en minuscule, la fonction sera plus rapide]

Bien cordialement, @+

VB:

Function Type_Contact$(ByVal Cel_Ref$)
If Cel_Ref = "" Then Type_Contact = "": Exit Function
Dim LCel_Ref$
LCel_Ref = LCase(Cel_Ref)
If InStr(1, LCel_Ref, "std") Then Type_Contact = "Standard": Exit Function
If InStr(1, LCel_Ref, "fax") Then Type_Contact = "Télécopie": Exit Function
If InStr(1, LCel_Ref, "dom") Then Type_Contact = "Domicile": Exit Function
If InStr(1, LCel_Ref, "perso") > 0 And InStr(1, Cel_Ref, "@") > 0 Then Type_Contact = "Courriel perso": Exit Function
If InStr(1, LCel_Ref, "perso") Then Type_Contact = "Mobile perso": Exit Function
If InStr(1, Cel_Ref, "@") Then Type_Contact = "Courriel": Exit Function
If InStr(1, LCel_Ref, "pro") Then Type_Contact = "Mobile pro": Exit Function
If InStr(1, LCel_Ref, "sce") Then Type_Contact = "Service": Exit Function
If InStr(1, Cel_Ref, "CE") Then Type_Contact = "Local CE": Exit Function
If InStr(1, Cel_Ref, "LD") Then Type_Contact = "Ligne directe": Exit Function
If Right(Cel_Ref, 2) = "00" Then Type_Contact = "Standard": Exit Function
If Left(Cel_Ref, 2) = "06" Or Left(Cel_Ref, 2) = "07" Then Type_Contact = "Mobile": Exit Function
Type_Contact = "Travail"
End Function

didcac · 9 Novembre 2021

Oui, là avec cette version 2 c'est parfait, les données sont mieux gérées, merci bien.
J'ai même pu rajouter une fonction de plus. Je ne connaissais pas le VBE (bien pratique), seulement les Macros.

D'ailleurs, comment peut-on "rafraîchir" le fichier lorsqu'on a ajouté une fonction mais que les changements ne sont pas instantanés ? Il y a une commande, pour ça ?
Merci.

Bernard_XLD · 9 Novembre 2021

Bonjour le fil, le forum

didcac à dit:
D'ailleurs, comment peut-on "rafraîchir" le fichier lorsqu'on a ajouté une fonction mais que les changements ne sont pas instantanés ? Il y a une commande, pour ça ?

Je ne comprends pas trop votre question, quand on ajoute une fonction, les changements sont instantanés à moins que le calcul ne se fasse que sur ordre (option d'Excel). J'ai ajouté dans le post 9 un Application.Volatile pour que la fonction se recalcule à tout événement Change dans la feuille même si elle n'est pas en dépendance directe.
Sinon un appui sur la touche F9 force le recalcul, vous pouvez aussi vous assurer que le calcul automatique est bien activé dans les options d'Excel.
Après, la fonction personnalisée s'utilise comme toute fonction d'Excel et peut être aussi directement appelée par Vba.

Bien cordialement, @+

Bernard_XLD · 9 Novembre 2021

re,

didcac à dit:
D'ailleurs, comment peut-on "rafraîchir" le fichier lorsqu'on a ajouté une fonction mais que les changements ne sont pas instantanés ? Il y a une commande, pour ça ?

Je viens de comprendre, vous modifiez la fonction personnalisée mais les nouvelles valeurs ajoutées ne sont pas prises en compte immédiatement !
un appui sur F9 forcera le recalcul et les valeurs se mettront à jour
J'ai enlevé, du coup, le Application.Volatile que j'avais ajouté et qui ne servait pas, sauf à ralentir l'utilisation du fichier en imposant des recalculs non nécessaires.

Bien cordialement, @+

didcac · 9 Novembre 2021

Bonjour,
Oui, c'est exactement cela...
D'accord, merci !
En fait, je suis sur MAC où F9 n'a pas la même fonction... et la combinaison "COMMANDE =" censée faire ça ne marche pas vraiment. Donc, en collant tout bêtement la base entière, ça a tout relancé. Et c'est parfait.
Merci pour tout !
Je devrais pouvoir m'en sortir plutôt bien comme ça. Sinon, je reviendrai faire un petit tour sur le Forum.

Bernard_XLD · 9 Novembre 2021

Sinon réintégrez application.volatile dans la fonction
Il suffira ensuite d'ouvrir une cellule n'importe ou , faire un changement même à l'identique
La validation déclenchera le recalcul de la fonction dans toutes les cellules

XL 2016 Typologie de contacts

didcac

XLDnaute Occasionnel

Pièces jointes

Bernard_XLD

JHA

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

didcac

XLDnaute Occasionnel

didcac

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

didcac

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

didcac

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

didcac

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

Discussions similaires