Macro: effacer "chaines de caractere" en doublons dans cellule + ordonner "chaines de caracteres"

Bonjour,

Voir PJ

http://cjoint.com/?ehlquVLIP1

JB
http://boisgontierjacques.free.fr


On 7 avr, 11:08, Christophe <cj...@mail.doc.gov> wrote:

Bonjour:

Les cellules de la colonne AE de ma feuille Excel contiennent des noms
de regions du genre

Central America & Caribbean
Central/South Asia
East Asia
Middle East & North Africa
Russia & the NIS
South America
South Pacific
Western Europe
etc.

Je souhaiterais
1- effacer les regions en doublons dans chaque cellule
2- ordonner les regions par ordre alphabetique dans chaque cellule

Ex.

En AE2  South Pacific, Western Europe, South Pacific,  South America,
Western Europe, East Asia -------> East Asia, South America, South
Pacific, Western Europe

Merci d'avance pour votre aide et sincères salutations.

Christophe

Bonjour:

Merci JB mais ma problematique est quelque peu differente. Il s'agit
dans un premier lieu d'effacer les "doublons" présent dans chaque
cellules de la colonne AE et d'ensuite de les trier par ordre alfa la
encore dans chacune des cellules de AE par opposition a effacer les
cellules doublons d'une cellule.

Remerciements.

Christophe

Set champ = Range("AE2:AE" & [AE2].End(xlDown).Row)
For Each c In champ
If Application.CountIf(champ, c) > 1 Then c.Clear
Next c
champ.Sort Key1:=Range("AE2"), Order1:=xlAscending, Header:=xlGuess

JB



On 7 avr, 11:51, Christophe <cj...@mail.doc.gov> wrote:

Bonjour:

Merci JB mais ma problematique est quelque peu differente.  Il s'agit
dans un premier lieu d'effacer les "doublons" présent dans chaque
cellules de la colonne AE et d'ensuite de les trier par ordre alfa la
encore dans chacune des cellules de AE par opposition a effacer les
cellules doublons d'une cellule.

Remerciements.

Christophe

Bonjour JB:

Je ne comprends pas tout mais ca me semble etre la bonne direction.
Malheureusement cela ne fonctionne pas encore.

Exemple dans AE2 j'ai
Middle East, South America, South America, Canada, South America, East
Asia, Central America & Caribbean, South America, Middle East & North
Africa, Central America & Caribbean, Central America & Caribbean,
Central America & Caribbean, East Asia, Central/South Asia, Middle
East & North Africa, Central America & Caribbean, Middle East & North
Africa, Mexico, Central America & Caribbean, Central America &
Caribbean, South America, South America, Middle East & North Africa,
Sub-Saharan
Africa, Central America & Caribbean, Middle East & North Africa, USA,
South America

et dans AE3
South Pacific, Western Europe, Middle East, Central/Eastern Europe,
Western Europe, Western Europe, Central/Eastern Europe, East Asia,
Western Europe, Central/Eastern Europe, Western Europe, Middle East &
North Africa, Western Europe, Western Europe, Western Europe, Western
Europe, Western Europe, Western Europe, East Asia, Central/Eastern
Europe, Western Europe, Central/South Asia, Southeast Asia, Western
Europe, Middle East & North Africa, Western Europe, Central/South
Asia, East Asia, Middle East & North Africa, Western Europe, Middle
East & North Africa, Lithuania, Macedonia, Malaysia, Netherlands, New
Zealand, Norway, Oman, Pakistan, Philippines, Poland, Portugal, Qatar,
Romania, Russia, Saudi Arabia, Western Europe, Southeast Asia, Slovak
Republic, Slovenia, South Africa, Spain, Sri Lanka, Sweden, Western
Europe, Taiwan, Thailand, Turkey, Ukraine, United Arab Emirates,
Western Europe, Vietnam

mais lorsque je lance la macro, il ne se passe rien.

Remerciements et sinceres salutations.

Christophe

ReBonjour JB:

D'après ce que je comprends ta macro supprime les cellules doublons
dans la colonne AE et ensuite tri la colonne en fonction d'un ordre
alphabetique.

Je me suis sans doute mal exprimé car ma problématique est différente
il s'agit en fait de supprimer les doublons de 'Chaines de Caractères"
dans chacune des cellules de la colonne AE et ensuite de trier les
chaines de caractères dans la cellule par ordre alphabétique. Le
séparateur de chaines de caractès etant la virgule (, )

Par exemple si dans la cellule AE2 j'ai

Middle East, South America, South America, Canada, South America, East
Asia, Central America & Caribbean, South America, Middle East & North
Africa, Central America & Caribbean, Central America & Caribbean,
Central America & Caribbean, East Asia, Central/South Asia, Middle
East & North Africa, Central America & Caribbean, Middle East & North
Africa, Mexico, Central America & Caribbean, Central America &
Caribbean, South America, South America, Middle East & North Africa,
Sub-Saharan Africa, Central America & Caribbean, Middle East & North
Africa, USA, South America

je souhaite obtenir après dans la cellule AE2:

Canada, Central America & Caribbean, Central/South Asia, East Asia,
Mexico, Middle East, Middle East & North Africa, South America, Sub-
Saharan Africa, USA

(les chaines de caratères (regions) en doublons sont effacées et les
chaines de caractères restantes sont triées par ordre alphabétique).

Merci. Christophe

Bonjour:

J'ai trouvé une macro developpée par Jason Lepack qui supprime les
mots en double dans chaque cellule d'une selection. le problème est
qu'elle prend en compte des mots sans espace et non pas des chaines de
caractères encadrées par des virgules. Peut-être que quelqu'un saura
la modifier pour qu'elle fonctionne dans mon cas de figure? On verra
le tri après...

' Removes duplicates within a cell from a range of
' selected cells
'Macro by Jason Lepack from
Sub removeDupes()
Dim x As Integer
Dim t As String, m As String
Dim c As Range, r As Range
Dim l As New Collection
Dim v As Variant
Dim b As Boolean

Set r = Selection
For Each c In r
t = c.Value
Do While Not t = ""
x = InStr(1, t, " ") ' find the first " "
' if we're not at the end of the string then
' the m is the string before the next space
' otherwise t the last word
If Not x = 0 Then
m = Mid(t, 1, x - 1)
Else
m = t
End If
If Not m = "" Then ' don't bother if m is empty
b = False
' looks to see if this word already exists
For Each v In l
If m = v Then
b = True
End If
Next v
' if it's not a duplicate then add it
If Not b Then
l.Add m
End If
End If
' remove the current word from the start of t
t = Mid(t, Len(m) + 2)
Loop
' put the non-dupe words back into the cell
c.Value = ""
For Each v In l
c.Value = c.Value & v & " "
l.Remove (1)
Next v
If Not c.Value = "" Then
c.Value = Left(c.Value, Len(c.Value) - 1)
End If
Next c


End Sub

Bonjour:

Si trop compliqué ne cherchez plus. Je vais feinter en utilisant la
macro ci-dessus en y intégrant au début une ligne pour remplacer tous
les espaces par un caractère improbable ex. @, puis
rempacer ,@par ,espace
puis en fin de macro remplacer @ par espace.

En revanche je suis toujours interessé par le tri par ordre
alphabétique des mots ou chaines de caractères séparés par des
virgules à l'intérieur d'une cellule. J'ai trouvé la macro ci-dessous
qui fonctionne parfaitement pour la cellule active mais je voudrais la
modifier pour la plage de cellules Range("AE2:AE" &
[AE2].End(xlDown).Row) . Merci d'avance pour votre aide. Je vais sans
doutre ouvrir un nouveau fil pour plus de clarté.

Christophe

Sub TriCellule()
'
' TriCellule Macro
' La fonction Split transforme une chaîne en tableau
' La fonction Join fait l'inverse
'
Dim Chn As String, Tri As Boolean, I As Integer, Tmp As String
Chn = ActiveCell.Text
If Chn = "" Then Exit Sub
TbChn = Split(Chn, ",")
If UBound(TbChn) > 0 Then
Do
Tri = False
For I = 1 To UBound(TbChn)
If TbChn(I) < TbChn(I - 1) Then
Tmp = TbChn(I - 1)
TbChn(I - 1) = TbChn(I)
TbChn(I) = Tmp
Tri = True
End If
Next
Loop While Tri = True
Chn = Join(TbChn, ",")
ActiveCell.Value = Chn
End If
'
End Sub