• Initiateur de la discussion Initiateur de la discussion Stoody
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S

Stoody

Guest
bonjour
j'ai une liste de mail dans la colonne A.
Je veux trier les mails par leurs suffixe (.fr .com .de ....) et les inscrires dans les colonnes B, C, D etc il doit avoir autant de colonne remplie que de suffixe différent, ainsi par exemple le colonne B aura tout les com, la C tous les fr etc.

Je suppose qu il y a un nombre infini de suffixe différent

merci pour votre aide
 
Salut,

Voilà un fichier qui pourrait t'aider. Je pense que tu devrais t'en sortir avec ce classeur. A remettre en forme pour ton application.

NOTES : L'auteur de ce fichier se reconnaitra. Désolé, je ne sais plus à qui il appartient.

Rv_Mikey
 
Bonsoir amis(ies) forumeurs

Stoody j'ai pondu (ne pas me prendre pour une poule par contre) une petite macro.

Option Explicit
Sub Classer_email()
'Déclarer les variables
Dim i As Byte
Dim Der_ligne(50) As Integer
Dim ligne As Integer
Dim position As Byte
Dim extension As String
Dim Colonne As Byte
'Affectation des variables
For i = 1 To 50
Der_ligne(i) = 2
Next i
'Effacer le tableau
Columns("B:AX").ClearContents
'Triage des adresses E-mail
Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Créer les extensions
For ligne = 2 To Range("a65535").End(xlUp).Row
position = Application.WorksheetFunction.Find(".", Cells(ligne, 1), 1)
extension = Right(Cells(ligne, 1), Len(Cells(ligne, 1)) - position)
For Colonne = 2 To Range("IV1").End(xlToLeft).Column
If Cells(1, Colonne) = extension Then GoTo Saut:
Next Colonne
Cells(1, Range("IV1").End(xlToLeft).Column + 1) = extension
Saut:
Next ligne
'Triage des extensions
Range("B1:AX1").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
'Transférer les adresses E-Mail
For ligne = 2 To Range("a65535").End(xlUp).Row
position = Application.WorksheetFunction.Find(".", Cells(ligne, 1), 1)
extension = Right(Cells(ligne, 1), Len(Cells(ligne, 1)) - position)
Colonne = Application.WorksheetFunction.Match(extension, Range("A1:AX1"), 0)
Cells(Der_ligne(Colonne), Colonne) = Cells(ligne, 1)
Der_ligne(Colonne) = Der_ligne(Colonne) + 1
Next ligne
End Sub

A suivre
smiley_417.gif


P.S. Prière d'accuser réception si cela te convient
ou ne convient pas en répondant sur ce Post ... Merci !
 
a mon avis ca va me prendre des années avant de bien tout comprendre. Evidemment c'est plus que parfait.

peut tu juste m'expliquer comment tu fais pour reconnaitre le suffixe et le mettre dans une des colonne

merci bcp

ps: si tu veux on en discute par mail, pour éviter d encombrer le forum
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
8
Affichages
411
Réponses
13
Affichages
136
Réponses
7
Affichages
312
Réponses
15
Affichages
478
Retour