supprimer les doublons texte

[chifounou]

Bonjour, j'ai une cellule A1 qui contient une chaine de texte de cet accabit :
email1,email1,email2,email2,email3,email3,email4,email4

les emails sont en doubles et toujours 2 par 2 à la suite

quelle fonction appliquer pour que la chaine de texte soit transformée en :
email1,email2,email3,email4

merci d'avance !

 

[Roland_M]

Bonsoir,

à condition que ce soit bien comme tu le montres dans cet ordre !?
exemple avec une fonction:
en A1 email1,email1,email2,email2,email3,email3,email4,email4
en A2 = TraiteAdresMail(A1)
ce qui donne: email1,email2,email3,email4

Function TraiteAdresMail(Chaine As Variant)
On Error Resume Next
Dim Tablo As Variant, M$
Tablo = Split(Chaine, ",")
For I = 1 To UBound(Tablo) Step 2: M$ = M$ & Tablo(I) & ",": Next
If Len(M$) > 1 Then M$ = Left(M$, Len(M$) - 1)
TraiteAdresMail = M$
End Function

 

[mapomme]

Bonjour chifounou, Roland_M ,

Une autre fonction qui permet des entrées dans n'importe quel ordre:

Function OterDoublons(x) As String
Dim T, D, i&
   T = Split(x, ",")
   Set D = CreateObject("scripting.dictionary"): D.comparemode = vbTextCompare
   For i = 0 To UBound(T)
      If Trim(T(i)) <> "" Then D(T(i)) = ""
   Next i
   OterDoublons = Join(D.keys, ",")
End Function

 

[chifounou]

Bonsoir mapomme et Rolan_M,

Merci à vous deux pour le coup de main. J'ai donc appris qu'on pouvait créer des fonctions personnalisées : cool

Petit soucis: mon but est en fait de récupérer la liste d'emails - pas seulement de l'afficher visuellement - mais aussi de séparer les emails entre eux sous forme de colonne et que leur texte apparaisse à la place d'une fonction (pour pouvoir copier-coller les cellules ensuite).

Dans mon fichier joint, l'objectif est en rouge (depuis C6 vers le bas)

Merci d'avance si vous pouvez boucler la boucle (hors e mes cordes)

 

[mapomme]

Bonjour chifounou,

(...) Petit soucis: mon but est en fait de récupérer la liste d'emails - pas seulement de l'afficher visuellement - mais aussi de séparer les emails entre eux sous forme de colonne et que leur texte apparaisse à la place d'une fonction (pour pouvoir copier-coller les cellules ensuite). (...)

En utilisant la fonction OterDoublons de la v1, une macro nommée : Sub EnColonne()
Cettre macro comporte 4 constantes à adapter à votre cas réel.

Sub EnColonne()
Const FeuilSource = "helper", CellSource = "B3"
Const Feuilcible = "helper", CellCible = "C6"
Dim T

   T = Split(OterDoublons(Sheets(FeuilSource).Range(CellSource)), ",")
   With Sheets(Feuilcible)
      .Range(.Range(CellCible), .Cells(.Rows.Count, .Range(CellCible).Column)).ClearContents
      If UBound(T) >= 0 Then .Range(CellCible).Resize(UBound(T) + 1) = Application.Transpose(T)
   End With
End Sub

nota : Si la cellule source peut comporter plus de 65 536 mails différents, me le signaler pour adapter le code. En effet la fonction Transpose bogue au delà de 65 536 éléments à transposer. Comme la source est la valeur d'une seule cellule, je pense que ce cas ne se produira pas .

 

[chifounou]

Merci beaucoup mapomme : ça fonctionne exactement comme anticipé top !

 

[chifounou]

Y'aurait-il un moyen que dans la dernière macro, en plus :
* la casse des emails écrits en majuscules (je n'avais pas fait attention désolé) soit transformée en minuscules (symboles , et @ devant être laissés intacts évidemment)
* et que la colonne verticale d'emails soit triée alphabétiquement ?



Merci encore !

 

[mapomme]

Bonsoir chifounou,

(...) Y'aurait-il un moyen que dans la dernière macro, en plus :
* la casse des emails écrits en majuscules (je n'avais pas fait attention désolé) soit transformée en minuscules (symboles , et @ devant être laissés intacts évidemment)
* et que la colonne verticale d'emails soit triée alphabétiquement ? (...)

Voir fichier v3 joint.

 

[chifounou]

que dire ...un très grand merci pour ta patience et ton expertise ! vraiment !