XL 2016 trier un champ Alphabétiquement

[alain160]

Bonjour.

J’ai une liste de noms sur 4 colonnes (A1 à D29)

Comment trier alphabétiquement tous ces noms

Le premier nom alphabétique devant se trouver en A1

Le dernier nom alphabétique en D29

Merci par avance

 

[Hecatonchire]

Bonjour Alain,

Je n'ai peut être pas compris ta demande.
Je te propose de générer le tri sur une autre plage avec cette formule
=ORGA.COLS(TRIER(DANSCOL(A129));29)

 

[JHA]

Bonjour à tous,

Un début avec Power Query à améliorer.

JHA

 

[alain160]

Bonjour Hecatonchire

Merci pour votre réponse mais ça ne répond pas tout à fait à mes souhaits.
Je souhaiterais que la mise en forme du texte soit conservée et j’ai oublié de préciser que la hauteur des colonnes n’est pas identique ….. Ce qui complique le tri.
Pour être plus clair, je joins un tableau récapitulatif.
Je précise qu’une solution avec une macro VBA pourrait me convenir aussi.

Merci par avance et cordialement

 

[job75]

Bonjour alain160, le forum,

Voyez le fichier .xlsm joint el la macro affectée au bouton :

Sub Trier()
Dim source As Range, dest As Range, c As Range, n&, ncol%, nlig&, j%, i&, nn&
Set source = [A1:D29] 'modifiable
Set dest = [F3] 'modifiable
Application.ScreenUpdating = False
dest.CurrentRegion.Clear 'RAZ
For Each c In source
    If c <> "" Then n = n + 1: c.Copy dest(n)
Next c
If n = 0 Then Exit Sub
dest.Resize(n).Sort dest, xlAscending, Header:=xlNo 'tri
ncol = source.Columns.Count
nlig = Application.RoundUp(n / ncol, 0)
For j = 1 To ncol
    For i = 1 To nlig
        nn = nn + 1
        If j > 1 Then dest(nn).Copy dest(i, j)
        If nn = n Then Exit For
Next i, j
If n > nlig Then dest.Offset(nlig).Resize(n - nlig).Clear 'effacement en bloc
End Sub

A+

 

[alain160]

Merci beaucoup Job75
J'ai essayé et ça fonctionne
cordialement

 

[job75]

Bonjour le forum,

La macro précédente restitue le tri par colonne, celle-ci le restitue par ligne :

Sub Trier()
Dim source As Range, dest As Range, c As Range, n&, ncol%, nlig&, nn&
Set source = [A1:D29] 'modifiable
Set dest = [F3] 'modifiable
Application.ScreenUpdating = False
dest.CurrentRegion.Clear 'RAZ
For Each c In source
    If c <> "" Then n = n + 1: c.Copy dest(n)
Next c
If n = 0 Then Exit Sub
dest.Resize(n).Sort dest, xlAscending, Header:=xlNo 'tri
ncol = source.Columns.Count
nlig = Application.RoundUp(n / ncol, 0)
For Each c In dest.Resize(nlig, ncol)
    nn = nn + 1
    dest(nn).Copy c
    If nn = n Then Exit For
Next c
If n > nlig Then dest.Offset(nlig).Resize(n - nlig).Clear 'effacement en bloc
End Sub

A+

 

[mapomme]

Bonjour à tous,

Un autre essai qui conserve aussi les bordures (je n'avais jamais fait attention que le .Sort ne triait pas les bordures avec les cellules du moins sur mon excel).
Le code dans module1 :

Sub Tri()
Const source = "a3", nbrCol = 4, Cible = "f3"
Dim t, i&, j&, k&, n&, nlig&
   Application.ScreenUpdating = False
   i = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
   t = Range(source).Resize(i, 4)
   ReDim lesVal(1 To UBound(t) * UBound(t, 2)): ReDim lesAdr(1 To UBound(t) * UBound(t, 2))
   For i = 1 To UBound(t): For j = 1 To UBound(t, 2)
      If t(i, j) <> "" Then n = n + 1: lesVal(n) = t(i, j): lesAdr(n) = Range(source)(i, j).Address(0, 0)
   Next j, i
   QuickSort lesVal, 1, n, lesAdr
   nlig = Int(n / nbrCol): If nbrCol * nlig < n Then nlig = nlig + 1
   Range(Range(Cible), Range(Cible).End(xlDown)).Resize(, nbrCol).Clear
   For i = 1 To n
      Range(lesAdr(i)).Copy Range(Cible).Cells(1 + ((i - 1) Mod nlig), 1 + Int((i - 1) / nlig))
   Next i
End Sub

Sub QuickSort(a, gauc, droi, aa)    ' d'après Jacques Boisgontier
'  Voir le code dans le classeur joint...
End Sub

 

[job75]

Bonjour mapomme,

Bravo mais puisque les bordures ne suivent pas il vaut mieux ne pas les utiliser quand on trie...

A+

 

[job75]

Bon pour trier avec les bordures on peut utiliser des formules de liaison :

Sub Trier()
Dim source As Range, dest As Range, c As Range, n&, ncol%, nlig&, j%, i&, nn&
Set source = [A1:D29] 'modifiable
Set dest = [F3] 'modifiable
Application.ScreenUpdating = False
dest.CurrentRegion.Clear 'RAZ
For Each c In source
    If c <> "" Then n = n + 1: dest(n) = "=" & c.Address 'formule de liaison
Next c
If n = 0 Then Exit Sub
dest.Resize(n).Sort dest, xlAscending, Header:=xlNo 'tri
ncol = source.Columns.Count
nlig = Application.RoundUp(n / ncol, 0)
For j = 1 To ncol
    For i = 1 To nlig
        nn = nn + 1
        Range(Mid(dest(nn).Formula, 2)).Copy dest(i, j)
        If nn = n Then Exit For
Next i, j
If n > nlig Then dest.Offset(nlig).Resize(n - nlig).Clear 'effacement en bloc
End Sub

Chez moi cette macro s'exécute en 0,118 seconde contre 0,185 seconde pour celle du post #5.

Testée dans les mêmes conditions la macro de mapomme s'exécute en 0,106 seconde.