Trier par ordre alphabétique certaine cellule

Yann71

XLDnaute Occasionnel
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.
 

Yann71

XLDnaute Occasionnel
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.
 

Pièces jointes

  • Classeur1TEST.xlsx
    10 KB · Affichages: 2

job75

XLDnaute Barbatruc
Re,

Voyez le fichier joint et ces macros :
Code:
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+
 

Pièces jointes

  • Tri disjoint(1).xlsm
    23.3 KB · Affichages: 4

Yann71

XLDnaute Occasionnel
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.
 

Pièces jointes

  • Tri disjoint(1) (1).xlsm
    87.6 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bah si des cellules à trier sont vides il suffit de remplacer leur valeur "" par "zzz" :
Code:
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
 

Pièces jointes

  • Tri disjoint(2).xlsm
    61.3 KB · Affichages: 3

job75

XLDnaute Barbatruc
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 :
Code:
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+
 

Pièces jointes

  • Tri disjoint(3).xlsm
    63.8 KB · Affichages: 9
Dernière édition:

Yann71

XLDnaute Occasionnel
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.
 

Discussions similaires

Statistiques des forums

Discussions
311 727
Messages
2 081 962
Membres
101 852
dernier inscrit
dthi16088