Extraction chaîne de caractère

[papypog]

Bonjour,

Dans l'exemple qui suit j'aurai besoin d'extraire et d'inscrire dans une autre cellule l'adresse se trouvant entre < et >
(reason: 550 5.1.1 <identifiant@domaine.net> Boite aux lettres inconnue - recipient rejected)
Ex si le texte est en A1 retrouver l'extraction en B1

J'ai réussi sans problème en utilisant les fonctions CHERCHE ; DROITE et GAUCHE mais je pense qu'il doit y avoir plus simple en vba
Il doit falloir utiliser entre la fonction Instr ( pas split valable qu'à partir d'excel 2000) mais je ne sais pas comment intégrer ça dans un script.

Merci de votre aide

 

[mutzik]

Re : Extraction chaîne de caractère

bonjour,

certainement faisable en VBA, mais toujours moins rapide que les fonctions cherche ...

 

[myDearFriend!]

Re : Extraction chaîne de caractère

Bonjour papypog, mutzik, le Forum,

Si j'ai bien compris, tu travailles toujours sous XL97...

Tu peux essayer avec la fonction personnalisée suivante (à copier dans un module de code standard) :

[COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]

[COLOR=NAVY]Function[/COLOR] AdrMail(R [COLOR=NAVY]As[/COLOR] Range) [COLOR=NAVY]As String
Dim[/COLOR] Pos [COLOR=NAVY]As Integer[/COLOR]
    Pos = InStr(1, R.Text, "<") + 1
    [COLOR=NAVY]If[/COLOR] Pos > 0 [COLOR=NAVY]Then[/COLOR]
        AdrMail = Mid(R.Text, Pos, InStr(1, R.Text, ">") - Pos)
    [COLOR=NAVY]End If
End Function[/COLOR]

Soit en A1, par exemple la valeur : "(reason: 550 5.1.1 <identifiant@domaine.net> Boite aux lettres inconnue - recipient rejected)",
En B1, tu peux saisir : =AdrMail(A1)

Cordialement,

 

[papypog]

Re : Extraction chaîne de caractère

Merci Didier_MDF,

D'abord merci de t'être occupé de mon cas, mais j'ai beau suivre tes conseils, coller le code tel quel dans un module, le résultat qui s'affiche en B1 est #NOM.
Une macro complémentaire est-elle absente ?

 

[myDearFriend!]

Re : Extraction chaîne de caractère

Re,

Si tu as appliqué ce que j'ai mis plus haut, il n'y a aucune raison pour que tu obtiennes ce résultat.

As-tu bien copié cette fonction personnalisée dans un module standard (ex : Module1) ?
As-tu bien mis =AdrMail(A1) dans la cellule cible ?

Pas besoin de macro complémentaire pour faire fonctionner une fonction personnalisée de la sorte...

 

[pierrejean]

Re : Extraction chaîne de caractère

bonjour papypog

Salut Bertrand
Salut Didier_mDF

Si je puis me permettre:

pour evacuer le cas ou le signe "<" n'est pas present

Function AdrMail(R As Range) As String
Dim Pos As Integer
    Pos = InStr(1, R.Text, "<") + 1
    If Pos > 1 Then
       AdrMail = Mid(R.Text, Pos, InStr(1, R.Text, ">") - Pos)
    Else
       AdrMail = ""
    End If
End Function

 

[myDearFriend!]

Re : Extraction chaîne de caractère

Bonsoir pierrejean,

Tu as tout à fait raison, prévoir ce cas est une bonne idée.

Cordialement,

 

[myDearFriend!]

Re : Extraction chaîne de caractère

Re,

Je rebondis sur la très bonne suggestion de pierrejean et propose dans ce cas, de gérer l'éventuelle absence des 2 caractères "<" et ">" :

[COLOR=NAVY]Function[/COLOR] AdrMail(R [COLOR=NAVY]As[/COLOR] Range) [COLOR=NAVY]As String
Dim[/COLOR] T [COLOR=NAVY]As String
Dim[/COLOR] Pos [COLOR=NAVY]As Integer[/COLOR]
    T = R.Text
    [COLOR=NAVY]If[/COLOR] T [COLOR=NAVY]Like[/COLOR] "*<*>*" [COLOR=NAVY]Then[/COLOR]
        Pos = InStr(1, T, "<") + 1
        AdrMail = Mid(T, Pos, InStr(1, T, ">") - Pos)
    [COLOR=NAVY]Else[/COLOR]
        AdrMail = ""
    [COLOR=NAVY]End If
End Function[/COLOR]

Cordialement,

 

[pierrejean]

Re : Extraction chaîne de caractère

Re

Effectivement je n'etais pas allé assez loin dans le raisonnement
Cette solution pallie l'absence de l'un ,de l'autre et celle des deux
Encore une astuce a memoriser !!

 

[papypog]

Re : Extraction chaîne de caractère

Merci à tous, maintenant ça marche je ne sais pas où j'ai m...é tout à l'heure.

Merci encore pour votre patience, par contre, si ce n'est pas trop abuser de cette dernière serait-il possible d'y ajouter les commentaires afin que je ne meurre pas idiot et que je puisse décrypter le code. Apprendre par coeur sans comprendre n'avance pas à grand chose.

PS pour Didier Et oui j'en suis encore avec mon ancêtre de XL97 mais que veux-tu, j'y tiens.

 

[THE CAT 2007]

Re : Extraction chaîne de caractère

Bonsoir à tous,

J'ai encore appris qqe chose ;-)

Je traduis en français de chez moi ....

Function AdrMail(R As Range) As String
Dim T As String 'variable texte
Dim Pos As Integer 'entier
T = R.Text ' T récupère la valeur texte de la cellule
'si T contient < et >, les * sont les jokers alors
If T Like "*<*>*" Then
Pos = InStr(1, T, "<") + 1 'la position du < est donnée
AdrMail = Mid(T, Pos, InStr(1, T, ">") - Pos)
Else
AdrMail = ""
End If
End Function

je décompose
AdrMail = Mid(T, Pos, InStr(1, T, ">") - Pos)
'InStr(1, T, ">") 'donne la position du >
'InStr(1, T, ">") - Pos ' donne le nombre de caractères à prendre( positon fin-position début)
'Mid(expression de texte à travailler,positon début,position de fin)
tronçonne le texte entre 2 valeurs de caractères du texte. ici < et >

si je ne me suis pas trompé :-(

 

[myDearFriend!]

Re : Extraction chaîne de caractère

Bonsoir THE CAT 2007,

Je pense que tu as tout compris

Avec toutefois une petite précision :
Mid(expression de texte à travailler,positon début,longueur de l'extraction)

Cordialement,

 

[papypog]

Re : Extraction chaîne de caractère

Re,

Et bien il ne me reste plus qu'à tous vous remercier chaleureusement pour votre patience et votre compréhension.

un papy qui s'endormira moins bête ce soir.