Tri par ordre alphabétique au sein d'une même cellule

[eramond]

Bonjour

Je souhaite trier le contenue d'une cellule par ordre alphabétique, est ce possible?

Exemple si C2 contient:
Thierry
Bernard

Après la macro

C2 =
Bernard
Thierry


Merci

 

[Dranreb]

Re : Tri par ordre alphabétique au sein d'une même cellule

J'ai fait quelque test et trouvé des bogues. Remplacez tout le code de Module2 par ça :

Option Explicit

Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
' Dim Te(1 To 500) As String, Le As Long  ' Variables globales module. Inutilisés ici
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
TDévia = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
TWorkon = WsS.Range("S2:T" & WsS.Range("S" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
   For Lw = 1 To UBound(TWorkon)
      If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)
      Next Lw
   TRésu(Ld, 1) = RésultatCellClassé: Next Ld
WsC.[AI2].Resize(UBound(TRésu)).Value = TRésu
' Application.ScreenUpdating = True ' N'apporte rien :  Assumé après exécution
' Application.Calculation = xlAutomatic ' Il n'a pas été mis XlManual que je sache.
End Sub

Et dans RésultatCellClassé ajoutez devant le Redim qui plante :

If Le = 0 Then RésultatCellClassé = "*Aucune correspondance*": Exit Function

Les bogues étaient :
1) - Erreur à Wsc.[AI2]: le 2 était oublié.
2) - Le cas où rien n'a été empilé par Ajouter n'était pas traité.

 

[eramond]

Re : Tri par ordre alphabétique au sein d'une même cellule

Toujours le même problème.

 

[Dranreb]

Re : Tri par ordre alphabétique au sein d'une même cellule

Oui, oui, dans RésultatCellClassé ajoutez devant le Redim qui plante : Code vb:
If Le = 0 Then RésultatCellClassé = "*Aucune correspondance*": Exit Function

 

[eramond]

Re : Tri par ordre alphabétique au sein d'une même cellule

merci

Visiblement le problème est ici maintenant

.Init 0, Le: While .Actif: .BInfA = Te(.B) < Te(.A): Wend

Dois je déclarer B et A as String?

 

[Dranreb]

Re : Tri par ordre alphabétique au sein d'une même cellule

Non, non. Ce sont des propriété de l'objet TableIndex. Il faut .Init 1, Le et non 0 en fait. Je rejoins le contenu de module 12 :

Option Explicit
Dim Te(1 To 500) As String, Le As Long  ' Variables globales module

Sub Ajouter(ByVal Z As String)
Le = Le + 1: Te(Le) = Z
End Sub

Function RésultatCellClassé() As String
Dim Ts() As String, Ls&, Texte As String ' Variables locales (volatiles)
If Le = 0 Then RésultatCellClassé = "*Aucune correspondance*": Exit Function
ReDim Ts(0 To Le - 1): Ls = -1
With New TableIndex
   .Init 1, Le: While .Actif: .BInfA = Te(.B) < Te(.A): Wend
   Texte = ""
   .Parcourir: While .Actif: Le = .Suivant
      If Te(Le) <> Texte Then Texte = Te(Le): Ls = Ls + 1: Ts(Ls) = Texte
      Wend: End With
ReDim Preserve Ts(0 To Ls)
RésultatCellClassé = Join(Ts, vbLf)
Le = 0
End Function

Ça devrait enfin avoir de bonnes chances de tourner. Chez moi ça marche. Je trouve ça :

Potential deviation

*Aucune correspondance*

Drilling_Holes_elongated Drilling_issue

Drilling_Holes_position

*Aucune correspondance*

Drilling_Oversize Drilling_issue

 

[eramond]

Re : Tri par ordre alphabétique au sein d'une même cellule

Puis je avoir votre fichier ?

Cela ne fonctionne pas, je suis trop nul ce n'est pas possible


Cela fonctionne merci c'est incroyable merci beaucoup

Je teste avec beaucoup de ligne tout de suite.

 

[Dranreb]

Re : Tri par ordre alphabétique au sein d'une même cellule

Le voici :

 

[eramond]

Re : Tri par ordre alphabétique au sein d'une même cellule

Impécable je passe de 35 min de macro à même pas 30s !

Merci vraiment j'ai appris beaucoup de choses.

 

[eramond]

Re : Tri par ordre alphabétique au sein d'une même cellule

Je vais essayer de faire la même chose pour les autres colonnes merci