Tri alphabétique du contenu d'une cellule

Résolu/Fermé
Baldurr Messages postés 7 Date d'inscription vendredi 15 octobre 2010 Statut Membre Dernière intervention 27 janvier 2011 - 27 janv. 2011 à 10:48
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 27 janv. 2011 à 13:39
Bonjour à toutes et tous,

Je ne trouve pas de Topic correspondant : imaginons que j'ai dans la cellule A1 "techno", dans la A2 "francais" et dans la cellule A3 "maths" par exemple. Connaîtriez-vous une Macro ou Fonction qui me permette d'avoir en B1, B2 et B3 les lettres de ses mots, triés par ordre alphabétique ? En B1, nous auront "ECHNOT", en B2 "AACFINRS" et "AHMST" en B3.

Un grand merci par avance (j'avais pondu quelque chose qui marché il y a q années, mais je l'ai égaré et ça me saoule de recommencer).

Au plaisir !

Explorer 7.0</config>

3 réponses

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
27 janv. 2011 à 12:40
Salut,
Une macro consisterait en :
Sub TriAlpha()
Dim tablo() As String
Dim I As Integer, dern As Integer, Valeur As Integer
Dim temp As String, resultat As String
dern = Len(ActiveCell)
ReDim tablo(dern)
For I = 0 To UBound(tablo)
    tablo(I) = Mid(ActiveCell, I + 1, 1)
Next
'sources du tri alpha : https://silkyroad.developpez.com/vba/tableaux/#LXIV-D
Do
    Valeur = 0
        For I = 0 To UBound(tablo) - 1
            If tablo(I) < tablo(I + 1) Then
                temp = tablo(I)
                tablo(I) = tablo(I + 1)
                tablo(I + 1) = temp
                Valeur = 1
            End If
            Next I
Loop While Valeur = 1

For I = UBound(tablo) - 1 To 0 Step -1
    resultat = resultat & tablo(I)
Next
ActiveCell.Offset(0, 1) = resultat
End Sub

Tu te places sur la cellule A1, ou tu as inscrit "techno", ALT+F8, exécute : TriAlpha. Le résultat en B1
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 27/01/2011 à 13:23
En complément d'après déjeuner, la fonction correspondante :
Function toto(cellu As String) 
Dim tablo() As String 
Dim I As Integer, dern As Integer, Valeur As Integer 
Dim temp As String, resultat As String 
dern = Len(cellu) 
ReDim tablo(dern) 
For I = 0 To UBound(tablo) 
    tablo(I) = Mid(cellu, I + 1, 1) 
Next 
'sources du tri alpha : https://silkyroad.developpez.com/vba/tableaux/#LXIV-D 
Do 
    Valeur = 0 
        For I = 0 To UBound(tablo) - 1 
            If tablo(I) < tablo(I + 1) Then 
                temp = tablo(I) 
                tablo(I) = tablo(I + 1) 
                tablo(I + 1) = temp 
                Valeur = 1 
            End If 
            Next I 
Loop While Valeur = 1 

For I = UBound(tablo) - 1 To 0 Step -1 
    resultat = resultat & tablo(I) 
Next 
toto = resultat 
End Function

Suffit de placer en B1 : =toto(A1)
0
Baldurr Messages postés 7 Date d'inscription vendredi 15 octobre 2010 Statut Membre Dernière intervention 27 janvier 2011
27 janv. 2011 à 13:34
OK, c'est assez proche de ce que cherchais (bien que très éloigné de ce que j'avais trouvé il y a qq temps). Je t'en remercie. Nota : j'ai créé un bouton et y ai affecté la macro, c'est + simple pour les tests.

Néanmoins, cela ne marche que cellule par cellule. Je vais zyeuter pour pouvoir sélectionner la plage A1:A3, executer la macro et hop, en B1:B3 apparaît le tri. Parce-que j'ai certains fichiers à + de 1000 lignes ... Je me vois mal me palucher la macro ligne par ligne :-)

Je cherche.

Merci encore, A+
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
27 janv. 2011 à 13:39
Ben suffit d'ajouter une boucle du style (pour traiter toute la colonne A à partir de A2 et résultat en colonne B :
Dim tablo() As String
Dim I As Integer, dern As Integer, Valeur As Integer
Dim temp As String, resultat As String
Dim Ligne As Integer, DerniereLigne As Integer

DerniereLigne = Range("A65536").End(xlUp).Row
For Ligne = 2 To DerniereLigne
dern = Len(Cells(Ligne, 1).Value)
ReDim tablo(dern)
For I = 0 To UBound(tablo)
    tablo(I) = Mid(Cells(Ligne, 1).Value, I + 1, 1)
Next
Do
    Valeur = 0
        For I = 0 To UBound(tablo) - 1
            If tablo(I) < tablo(I + 1) Then
                temp = tablo(I)
                tablo(I) = tablo(I + 1)
                tablo(I + 1) = temp
                Valeur = 1
            End If
            Next I
Loop While Valeur = 1

For I = UBound(tablo) - 1 To 0 Step -1
    resultat = resultat & tablo(I)
Next
Cells(Ligne, 2) = resultat
Next Ligne

Je t'ai même "grassouillé" les lignes de code modifiées...
0
Baldurr Messages postés 7 Date d'inscription vendredi 15 octobre 2010 Statut Membre Dernière intervention 27 janvier 2011
27 janv. 2011 à 13:39
OK, ma réponse a croisé la vôtre. Ca marche.

Merci beaucoup, sujet clos !
0