[2003] Traitement de chaîne

Bonsoir
En son temps, j'avais fait un truc du même genre, mais avec trouve.
D'abord, trouve"@", puis extraire les x caractères de la gauche de
l'adresse,
puis avec stxt, repartir du nombre donné par trouve, pour extraire le nom.
Si cela peut t'aider....
PS Ton point n°2, ce ne serait pas le "@" à prendre en référence?
2°) sépare le nom de l'adresse en fonction du signe "<"

Bonne soirée
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"Péhemme" a écrit dans le message de groupe de discussion :
4dbc606f$0$30782$ba4acef3@reader.news.orange.fr...

Bonjour à Tous,

J'ai (en colonne B) une liste d'adresse électronique du style
Jean Moulin <jean-moulin@hotmail.com>
Laurent Outan <l.outan@babouin.fr>
J. Raffe <Raffej@zoo.us>
L'objectif est de scinder en 2 colonnes
a) le nom
b) l'adresse électronique (sans les "<" et ">")
Pour ce faire, j'ai écrit la macro suivante (qui répond à mon problème) qui
comporte 2 boucles,
1°) retire le ">" final, puis,
2°) sépare le nom de l'adresse en fonction du signe "<"
Y a-t-il une écriture moins "bourrin" ?

Sub Extrait_()
Dim Rg As Range, Cel As Range, Ad As String
Dim R As Long, i As Integer
Dim Tableau() As String
R = Range("B65536").End(xlUp).Row
Set Rg = Range("B5:B" & R)
For Each Cel In Rg
Cel.Value = Replace(Cel.Value, ">", "")
Cel.Offset(0, 1) = Cel.Value
Next Cel
Set Rg = Rg.Offset(0, 1)
For Each Cel In Rg
Ad = Cel.Address
Tableau = Split(Range(Ad).Value, "<")
For i = 0 To UBound(Tableau)
Range(Ad).Offset(0, i + 1).Value = Tableau(i)
Next i
Next Cel
Set Rg = Nothing
Merci d'avance
Michel

Bonjour,

En supposant que tes adresses électroniques sont dans la colonne A
et que tu veux avoir le résultat en colonne B et C
Tout cela dans l'onglet de la feuille nommé : "Feuil1"
'--------------------------------------
Sub test()
Dim DerLig As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Feuil1")
DerLig = .Range("A65536").End(xlUp).Row
With .Range("A1:A" & DerLig)
.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:úlse, Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
.Range("B:C").Replace "<", "", xlPart
.Range("B:C").Replace ">", "", xlPart
.Range("B:C").EntireColumn.AutoFit
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'--------------------------------------


MichD
--------------------------------------------

Bonjour Denis,

Merci.
J'ai adapté et cela répond parfaitement à mon souhait.
J'ignorais l'existence de TextToColumns ; l'aide est bien faite, il ne me
reste plus qu'à m'entraîner.
À la lecture rapide des arguments, j'observe que FieldInfo joue, en quelque
sorte, le rôle de split.
Je continue de découvrir Excel 2003... Quand je pense que nombreux sont ceux
qui épuisent les joies de Excel 2010...
Merci également à Jacquouille de s'être penché sur mon triste sort.
;-))
Bien amicalement
Michel

"MichD" <michdenis@hotmail.com> a écrit dans le message de
news:ipi0g4$514$1@speranza.aioe.org...

Bonjour,

En supposant que tes adresses électroniques sont dans la colonne A
et que tu veux avoir le résultat en colonne B et C
Tout cela dans l'onglet de la feuille nommé : "Feuil1"
'--------------------------------------
Sub test()
Dim DerLig As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Feuil1")
DerLig = .Range("A65536").End(xlUp).Row
With .Range("A1:A" & DerLig)
.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:úlse, Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)),
TrailingMinusNumbers:=True
.Range("B:C").Replace "<", "", xlPart
.Range("B:C").Replace ">", "", xlPart
.Range("B:C").EntireColumn.AutoFit
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'--------------------------------------


MichD
--------------------------------------------