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

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion eramond
  • 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'inscrire
E

eramond

XLDnaute Junior
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
 
Dernière édition:
Trier par date Trier par votes
Re : Tri par ordre alphabétique au sein d'une même cellule

Merci beaucoup c'est exactement ce que je voulais !

J'ai exporter le module et la table sur mon fichier d'orginie, où dois je lui indiquer la colonne à trier?
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Merci

En fait c'est la colonne AI de l'onglet data-deviations que je souhaitre trier. Pour l'instant je n'y parviens pas.

Pour info la colone AI se remplit grêce à une macro ( module 1) qui fait un recherche v amélioré entre la colonne AG et les colonnes S&T de la feuille Work on
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Travaillez donc uniquement avec des tableaux VBA en mémoire: c'est beaucoup plus rapide.

Essayez en vous servant de ça:
VB: 
Option Explicit
Dim Te(1 To 500) As String, Le As Long

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

Function RésultatCellClassé() As String
Dim Ts() As String, Ls&
ReDim Ts(0 To Le - 1): Ls = -1
With New TableIndex
   .Init 1, Le: While .Actif: .BInfA = Te(.B) < Te(.A): Wend
   .Parcourir: While .Actif: Le = .Suivant: Ls = Ls + 1: Ts(Ls) = Te(Le): Wend: End With
RésultatCellClassé = Join(Ts, vbLf)
Le = 0
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Des trucs déclarés avec () derrière.
On peut y affecter directement des Value de Range en une seule instruction. Pareil dans l'autre sens.
La durée d'exécution d'une macro est essentiellement proportionnelle au nombre de fois qu'on utilise la méthode Range, et ne dépend presque pas du nombre de valeurs de cellules transférées à chacune de ses utilisations. 1000 Range d'une cellule est 1000 fois plus long qu'un seul Range de 1000 cellules. Je propose donc très souvent des codes où je n'en ai que deux: un au début: Te = PlageEntrée.Value et un autre à la fin: PlageSortie.Value = Ts
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Merci alors j'ai bricole un peu mon fichier en insérant votre feuille et avec un = les données triées reviennent dans le tableau adéquat

Par contrepour optimier mes Ranges comme vous le dites je ne vois pas où puis je les enlever d'ici

PHP: 
  For Each Cel In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
        MemoPos = 1000
        For Each c In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
            Position = InStr(Cel, c)
            If Position > 0 Then
                If Cel.Offset(0, 2) <> "" And InStr(Cel.Offset(0, 2), c.Offset(0, 1)) = 0 Then
                ' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                        Cel.Offset(0, 2) = c.Offset(0, 1) & Chr(10) & Cel.Offset(0, 2)
                    Else
                        Cel.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & c.Offset(0, 1)
                    End If
                Else
                    Cel.Offset(0, 2) = c.Offset(0, 1)
                    MemoPos = Position
                End If
            End If
        Next c
    Next Cel
    Set WsC = Nothing: Set WsS = Nothing
 
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Par contrepour optimier mes Ranges comme vous le dites je ne vois pas où puis je les enlever d'ici
Cliquez pour agrandir...
C'est très simple: vous les enlevez tous au milieu, dans les boucles, et vous n'en laissez qu'au début et à la fin. Et dans les boucles vous accédez uniquement, à la vitesse de la lumière, aux éléments de tableaux, les uns en entrée (ceux initialisés par les Range du début) d'autre en sortie (ceux à destination des Range de fin)
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Merci:

mon code est passé de ceci :

PHP: 
Sub Test()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, c As Range
Dim Position As Integer, MemoPos As Integer
    Set WsS = Worksheets("Workon")
    Set WsC = Worksheets("Data-Deviations")
   
    Sheets("Data-Deviations").Activate
 Range("AI2:AI1000000").ClearContents
 
    
  For Each Cel In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
        MemoPos = 1000
        For Each c In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
            Position = InStr(Cel, c)
            If Position > 0 Then
                If Cel.Offset(0, 2) <> "" And InStr(Cel.Offset(0, 2), c.Offset(0, 1)) = 0 Then
                ' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                        Cel.Offset(0, 2) = c.Offset(0, 1) & Chr(10) & Cel.Offset(0, 2)
                    Else
                        Cel.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & c.Offset(0, 1)
                    End If
                Else
                    Cel.Offset(0, 2) = c.Offset(0, 1)
                    MemoPos = Position
                End If
            End If
        Next c
    Next Cel
    Set WsC = Nothing: Set WsS = Nothing
    Application.ScreenUpdating = True
    
End Sub




A ceci


PHP: 
Sub Test()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, c As Range
Dim Position As Integer, MemoPos As Integer
    Set WsS = Worksheets("Workon")
    Set WsC = Worksheets("Data-Deviations")
     Dim Te As PlageEntrée.Value
     Dim Ts As PlageSortie.Value
     
     'Te = PlageEntrée.Value et un autre à la fin: PlageSortie.Value = Ts
    
   
    Sheets("Data-Deviations").Activate
 Range("AI2:AI1000000").ClearContents
 
    
  For Each Te In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
        MemoPos = 1000
        For Each Ts In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
            Position = InStr(Te, Ts)
            If Position > 0 Then
                If Te.Offset(0, 2) <> "" And InStr(Te.Offset(0, 2), Ts.Offset(0, 1)) = 0 Then
                ' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                        Te.Offset(0, 2) = Ts.Offset(0, 1) & Chr(10) & Te.Offset(0, 2)
                    Else
                        Te.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & Ts.Offset(0, 1)
                    End If
                Else
                    Te.Offset(0, 2) = Ts.Offset(0, 1)
                    MemoPos = Position
                End If
            End If
        Next Ts
    Next Te
    Set WsC = Nothing: Set WsS = Nothing
    Application.ScreenUpdating = True
    
End Sub

Mais cela ne fonctionne pas
 
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

BOISGONTIER à dit:
Bonjour,

Exemple en PJ

JB
Cliquez pour agrandir...


Cela fonctionne merci !

comment puis l'intégrer dans cette macro ?

PHP: 
Sub Test()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, c As Range
Dim Position As Integer, MemoPos As Integer
    Set WsS = Worksheets("Workon")
    Set WsC = Worksheets("Data-Deviations")
   
    Sheets("Data-Deviations").Activate
 Range("AI2:AI1000000").ClearContents
 
    
  For Each Cel In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
        MemoPos = 1000
        For Each c In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
            Position = InStr(Cel, c)
            If Position > 0 Then
                If Cel.Offset(0, 2) <> "" And InStr(Cel.Offset(0, 2), c.Offset(0, 1)) = 0 Then
                ' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                        Cel.Offset(0, 2) = c.Offset(0, 1) & Chr(10) & Cel.Offset(0, 2)
                    Else
                        Cel.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & c.Offset(0, 1)
                    End If
                Else
                    Cel.Offset(0, 2) = c.Offset(0, 1)
                    MemoPos = Position
                End If
            End If
        Next c
    Next Cel
    Set WsC = Nothing: Set WsS = Nothing
    Application.ScreenUpdating = True
    
End Sub

JE voudrais faire le tricell des celluls AI sheet data déviations une fois la macro finis
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tri par ordre alphabétique au sein d'une même cellule

Non la structure à observer serait plutôt dans ce style :
VB: 
TDévia = WsC.Range("AG2:AH" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
TWorkon = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
   mempos = 1000
   For Lw = 1 To UBound(TWorkon)
      Position = InStr(TDévia(Ld, 1), TWorkon(Lw, 1))
      If Position > 0 Then
          etc.
Avec cette version de la fonction RésultatCellClassé vous devriez pouvoir empiler les doublons avec Ajouter. C'est facile de les repérer après classement pour les éliminer puisqu'ils se retrouvent ensembles.
VB: 
Function RésultatCellClassé() As String
Dim Ts() As String, Ls&, Texte As String
ReDim Ts(0 To Le - 1): Ls = -1
With New TableIndex
   .Init 0, 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
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

A
  • Question Question
XL 2021 listbox
2
Réponses
18
Affichages
495
Dranreb
Dranreb
K
  • Résolu(e)
XL 2013 Problème de tri alphabétique avec scripting dictionary
2
Réponses
16
Affichages
388
ChTi160
ChTi160
K
  • Question Question
Problème de tri alphabétique sur scripting dictionary
Réponses
2
Affichages
138
kiko_23
K
rastafouette
  • Résolu(e)
XL 2021 tri par lignes
2
Réponses
19
Affichages
834
rastafouette
rastafouette
N
  • Résolu(e)
Microsoft 365 Trie croissant par ligne
Réponses
4
Affichages
130
sylvanu
sylvanu
F
  • Résolu(e)
Fredprof
Réponses
2
Affichages
439
Fredprof
F
B
  • Question Question
XL 2019 trouver le plus grand numéro
Réponses
11
Affichages
567
Blafi
B
F
  • Question Question
Microsoft 365 tri dans Excell
2
Réponses
19
Affichages
689
JHA
J
Y
  • Question Question
XL 2021 Liste déroulante filtrée par les 2 premiers caractères
2
Réponses
28
Affichages
667
Dudu2
Dudu2
B
  • Question Question
XL 2021 Tri alphabétique dans une cellule
Réponses
5
Affichages
616
Baldur
B
H
  • Question Question
tri dates par noms
Réponses
4
Affichages
343
HPR
H
M
  • Résolu(e)
XL 2021 Verrouillage de cellules après exécution d'une macro
2
Réponses
23
Affichages
846
MATLEA
M
P
  • Résolu(e)
XL 2019 Tri sur une ligne dans un tableau.
Réponses
4
Affichages
264
Paulle
P
S
  • Question Question
Power Query tri powerquery
Réponses
9
Affichages
1 K
JFL_XLD
J
E
  • Résolu(e)
Microsoft 365 Report d'une cellule
2
Réponses
17
Affichages
320
sylvanu
sylvanu
A
  • Question Question
Microsoft 365 Déplacer sans trier
Réponses
6
Affichages
283
sylvanu
sylvanu
F
  • Question Question
Autres Récupération de données d'une feuille X en fonction de la valeur de cellule dans une collone d'une feuille Y
2
Réponses
27
Affichages
1 K
fanfan38
fanfan38
G
  • Résolu(e)
XL 2019 Trier par ordre alphabétique de gauche à droite
Réponses
7
Affichages
500
Goffy
G
A
  • Question Question
XL 2019 Additionner des cellules espacées d'une valeur constante
2
Réponses
17
Affichages
479
Astyanax
A
A
  • Question Question
XL 2021 Comment préserver la première valeur d'une cellule uniquement si
2 3
Réponses
34
Affichages
1 K
Alamyr
A
Retour