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

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
E

eramond

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

Merci j'ai fait ceci mais cela ne fonctionne pas

PHP: 
Sub Test2()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia 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
 
  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
              If TDévia.Offset(0, 2) <> "" And InStr(TDévia.Offset(0, 2), TWorkon.Offset(0, 1)) = 0 Then
                ' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                        TDévia.Offset(0, 2) = TWorkon.Offset(0, 1) & Chr(10) & TDévia.Offset(0, 2)
                    Else
                        TDévia.Offset(0, 2) = TDévia.Offset(0, 2) & Chr(10) & TWorkon.Offset(0, 1)
                    End If
                Else
                    TDévia.Offset(0, 2) = TWorkon.Offset(0, 1)
                    MemoPos = Position
                End If
            End If
        Next TWorkon
    Next TDévia
    Set WsC = Nothing: Set WsS = Nothing
    Application.ScreenUpdating = True
    
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Il n'y a pas à utiliser Offset sur des tableaux: c'est TDévia(Ld, 2) pour avoir la colonne juste à droite de TDévia(Ld, 1)
Pensez à récupérer au début le nombre de colonnes qu'il faut pour ne pas avoir d'Indice en dehors de la plage.
Prévoyez un tableau résultant supplémentaire.

Ah et puis surtout, c'est pas Dim TWorkon As Range, TDévia As Range
C'est Dim TWorkon(), TDévia()
 
Dernière édition:
Vote positif 0 Vote négatif
E

eramond

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

Merci

Mais xls me dit qu'il attend un tableau après UBound je ne comprends pas.

PHP: 
ub Test2()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia 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
  
  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
              If TDévia(Ld, 2) <> "" And InStr(TDévia(Ld, 2), TWorkon(Lw, 1)) = 0 Then
                ' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                       TDévia(Ld, 2) = TWorkon(Lw, 1) & Chr(10) & TDévia(Ld, 2)
                    Else
                        TDévia(Ld, 2) = TDévia(Ld, 2) & Chr(10) & TWorkon(Lw, 1)
                    End If
                Else
                    TDévia(Ld, 2) = TWorkon(Lw, 1)
                    MemoPos = Position
                End If
            End If
        Next TWorkon
    Next TDévia
    Set WsC = Nothing: Set WsS = Nothing
    Application.ScreenUpdating = True
     
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Oui je viens de voir ça. Voir dernier Edit poste précédent.
Mais il ne faut plus empiler le résultat dans TDévia
C'est Ajouter LeTexte
et à la fin de la boucle TRésu(Ld, 1) = RésultatCellClassé
avec TRésu aussi déclaré TRésu() et ayant fait l'objet d'une instruction Redim TRésu(1 to Ubound(TDévia), 1 to 1)
et tout à la fin affecter LaCelluleDeDépart.Resize(Ubound(TRésu)).Value = TRésu
Rappel: plus besoin d'éviter d'empiler les doublons parce que mon dernier RésultatCellClassé les élimine.
 
Dernière édition:
Vote positif 0 Vote négatif
E

eramond

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

Merci, cela ne fonctionne pas :confused:

PHP: 
Sub Test2()
 Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia As Range, TRésu 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
   
  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)
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
   mempos = 1000
   For Lw = 1 To UBound(TWorkon)
      Position = InStr(TDévia(Ld, 1), TWorkon(Lw, 1))
      If Position > 0 Then
              If TDévia(Ld, 2) <> "" And InStr(TDévia(Ld, 2), TWorkon(Lw, 1)) = 0 Then
                ' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
                If Position < MemoPos Then
                        MemoPos = Position
                       TDévia(Ld, 2) = TWorkon(Lw, 1) & Chr(10) & TDévia(Ld, 2)
                    Else
                        TDévia(Ld, 2) = TDévia(Ld, 2) & Chr(10) & TWorkon(Lw, 1)
                    End If
                Else
                    TDévia(Ld, 2) = TWorkon(Lw, 1)
                    MemoPos = Position
                End If
            End If
        Next TWorkon
    Next TDévia
    TRésu(Ld, 1) = RésultatCellClassé
    Set WsC = Nothing: Set WsS = Nothing
    CelluleDeDépart.Resize(UBound(TRésu)).Value = TRésu
    Application.ScreenUpdating = True
      
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Mais le TRésu c'est pour toute la colonne, évidemment, il ne faut pas refaire un Redim dessus à chaque passage dans la boucle ! juste une fois après l'initialisation de TDévia.
Après c'est que je ne sais pas exactement ce que vous voulez faire, je n'y comprends rien, mais il me semble que vous testez toujours encore pour rien s'il y est déjà.
Et ce n'est pas Next TWorkon et TDévia mais Next Lw et Ld. Et il faut faire le TRésu(Ld, 1) = RésultatCellClassé juste avant.
Mais vous n'avez pas fait d'appel à la Sub Ajout pour remplir le tableau qui est ensuite restitué classé et sans doublon par RésultatCellClassé.
 
Dernière édition:
Vote positif 0 Vote négatif
E

eramond

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

Ok, excusez mais je suis ultra débutant dans vba.

Voici ce que fait ma macro

1. Ma macro test va chercher les mots clés dans la feuille Data-Deviations colonne AG
2. elle compare les mots grâce à la matrice présent en colonne S&T de la feuille Workon
3. elle les renvoie en colonne AI de la feuille Data-Deviations
4. elle supprime les valeurs en double au sein même des cellules de la colonne AI.
 

Pièces jointes

  • DATA-XX-XX-2015-XXX-DD.xlsm
    86 KB · Affichages: 27
  • DATA-XX-XX-2015-XXX-DD.xlsm
    86 KB · Affichages: 30
  • DATA-XX-XX-2015-XXX-DD.xlsm
    86 KB · Affichages: 41
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Bon mais alors je ne comprends pas comment il peut y en avoir plusieurs car il n'y a qu'un texte dans la colonne AG
Ah c'est parce qu'il peut y être plusieurs fois en S de Workon avec des valeurs différentes de T qu'il faut restituer, c'est ça ?
Bon ben alors eqssayez comme ça :
VB: 
Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
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.[AI].Resize(UBound(TRésu)).Value = TRésu
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
E

eramond

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

Exact pour plusieurs mots clés en colonne S je renvoie la même valeur en colonne T.

Donc si ma phrase en colonne AG contient plusieurs mots clés qui ont la même valeur en colone T, je ne veux afficher qu'une seule fois cette valeur.

J'essaye votre code tout de suite.
 
Vote positif 0 Vote négatif
E

eramond

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

Visiblement j'ai un problème avec Ajouter ici

PHP: 
  If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)

J'ai une pop up erreur de compilation SUb ou Function non définie.
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Attention j'avais oublié de remettre les Set WsS et WsC. C'est que moi je n'ai pas l'habitude car je trouve plus commode d'utiliser les noms d'objets Worksheet connus du projet VBA de la rubrique Microsoft Excel Objets
 
Dernière édition:
Vote positif 0 Vote négatif
E

eramond

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

J'ai modifié oui mais j'ai toujours ce problème de fonction ajouter non définie

PHP: 
Sub Test()

Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
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.[AI].Resize(UBound(TRésu)).Value = TRésu
Application.ScreenUpdating = True

  
End Sub
 
Vote positif 0 Vote négatif
E

eramond

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

J'ai rajouter ce module mais visiblement il a en manque un autre?

Que veux dire le ByVal on passe l'argument sous forme de valeur?

Je suis un peu perdu ;)
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Un autre quoi ? Une autre procédure ? La Function RésultatCellClassé ? Le module de classe TableIndex ?
Joignez le classeur, que je voie ce qui manque.
Que veux dire le ByVal on passe l'argument sous forme de valeur?
Cliquez pour agrandir...
Oui, c'est ça.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
Power Query tri powerquery
Réponses
9
Affichages
273
JFL_XLD
J
G
  • Résolu(e)
XL 2019 Trier par ordre alphabétique de gauche à droite
Réponses
7
Affichages
228
Goffy
G
halecs93
  • Résolu(e)
XL 2016 macro tri alphabétique des onglets
Réponses
6
Affichages
181
halecs93
halecs93
M
  • Question
Microsoft 365 Impossible de filtrer ou de classer par ordre alphabétique.
Réponses
2
Affichages
220
TooFatBoy
TooFatBoy
Y
  • Question
XL 2021 (RESOLU) Concaténation et Remplacement des Prénoms par Noms en ordre alpha
Réponses
7
Affichages
553
yannlion
Y
L
  • Résolu(e)
XL 2016 [Résolu] Liste déroulante dynamique sans vides et avec tri alphabétique (formule matricielle)
Réponses
4
Affichages
465
LOLO13130
L
xUpsilon
  • Résolu(e)
Microsoft 365 Trier sur le deuxième champ dans un TCD
2
Réponses
15
Affichages
442
xUpsilon
xUpsilon
F
  • Question
Microsoft 365 Copie de couleur de cellules
Réponses
3
Affichages
190
gbinforme
G
L
  • Résolu(e)
Microsoft 365 Tri TCD suivant ordre de la source
Réponses
13
Affichages
991
chris
chris
D
  • Question
XL 2016 Ranger par ordre alphabétique une ListBox dans un USF
Réponses
2
Affichages
281
Damien0507
D

Membres actuellement en ligne

8 membres et 87 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 361
Messages
2 087 617
Membres
103 607
dernier inscrit
lolo1970