Trier par ordre alphabétique certaine cellule

[Yann71]

Bonjour la com. J'aimerai savoir si il est possible de faire un tri par ordre alphabétique via VBA de certaines cellule dans une même colonne. Je m'explique, exemple j'aimerai que ces 4 cellule se mette dans l'ordre alphabétique A2, A5, A8, A10. Précision, j'aimerai que l'écriture reste dans la même cellule. Ce que je veux dire c'est ques mots reste affiché dans A2, A5 A8, A10, qu'elles ne se décale pas en A1, A2, A3,A4. J'espère avoir été assez claire dans ma demande.

 

[job75]

Bonjour Yann71

J'espère avoir été assez claire dans ma demande.

Non ce n'est pas clair, joignez un fichier avec les données avant et après traitement.

PS : pourquoi le e, vous êtes une femme ?

A+

 

[Yann71]

Non je ne suis pas une femme mais est-ce qu'il y a une importance quand à l'aide apportée 😉.
Je joins un exemple du fichier, avec des prénom pris au hasard bien entendu. Je vous remercie
par avance pour votre, ton aide.

 

[job75]

Re,

Voyez le fichier joint et ces macros :

Sub Tri_disjoint()
Dim tablo, a, b(), i&
tablo = [A1:A100] 'matrice, plus rapide
a = Array(1, 3, 5, 7)
ReDim b(UBound(a)) 'base o
For i = 0 To UBound(b)
    b(i) = tablo(a(i), 1)
Next
tri b, 0, UBound(b)
For i = 0 To UBound(b)
    tablo(a(i), 1) = b(i)
Next
[A1:A100] = tablo 'restitution
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

A+

 

[Yann71]

Bonsoir job75, merci pour ton intervention. Ton fichier fonctionne à merveille, mais un soucis persiste. Lorsque j'active le VBA, si il la dernière cellule n'est pas remplis, tous les noms sont mis dans l'ordre alphabétique mais sont décaler vers le bas, donc ce qui signifie que la première cellule est vide. J'aimerai justement l'inverse. Je te joint mon fichier tel qu'il devrait être.

 

[job75]

Bah si des cellules à trier sont vides il suffit de remplacer leur valeur "" par "zzz" :

Sub Tri_disjoint()
Dim tablo, a, b(), i&
tablo = [A1:A100] 'matrice, plus rapide
a = Array(5, 8, 11, 14, 17, 20)
ReDim b(UBound(a)) 'base o
For i = 0 To UBound(b)
    b(i) = tablo(a(i), 1)
    If b(i) = "" Then b(i) = "zzz"
Next
tri b, 0, UBound(b)
For i = 0 To UBound(b)
    If b(i) = "zzz" Then b(i) = ""
    tablo(a(i), 1) = b(i)
Next
[A1:A100] = tablo 'restitution
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

 

[job75]

Bonjour Yann71, le forum,

Tout ça c'est bien joli mais il faudrait que les autres colonnes du tableau suivent le tri non ???

Dans ce cas la méthode précédente ne va pas, il faut utiliser un document auxiliaire et y effectuer le tri :

Sub Tri_disjoint()
Dim ZoneTri As Range, coltri%, a, F As Worksheet, aux As Worksheet, P As Range, lig, R As Range, tablo, i&
Set ZoneTri = [A4:G21] 'à adapter, sans en-têtes
coltri = ZoneTri.Column 'à adapter éventuellement
a = Array(5, 8, 11, 14, 17, 20)
Set F = ActiveSheet
Application.ScreenUpdating = False
Set aux = Workbooks.Add.Sheets(1) 'document auxiliaire
Set P = aux.Range(ZoneTri.Address)
P = ZoneTri.Value
For Each lig In a
    If Not Intersect(F.Rows(lig), ZoneTri) Is Nothing Then
        Set R = F.Cells(lig, coltri + 1).MergeArea.EntireRow.Columns(coltri) 'plage fusionnée voisine
        aux.Range(R.Address) = aux.Cells(lig, coltri) 'remplissage de la colonne
    End If
Next lig
coltri = coltri - P.Column + 1
P.Sort P.Columns(coltri), xlAscending, Header:=xlNo 'tri
'---restitution---
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If ZoneTri(i, coltri) = "" Then tablo(i, coltri) = ""
Next
ZoneTri = tablo
aux.Parent.Close False 'ferme le document auxiliaire
End Sub

Fichier (3).

A+

 

[Yann71]

Bonjour jon75, dsl pour le retard de ma réponse. Merci de ton aide, ton fichier est l'idéal de ce que je souhaitai. J'apprécie tout particulièrement que tu aies anticipé le fait que je puisse faire le tris avec les autres colonnes. Je peux dire que ma demande est aboutie grâce à toi.
Merci encore pour tout, passes une bonne journée.​