Tris alphabétique

[b.lambelet]

Bonjour,
je souhaiterai pouvoir mettre par ordre alphabétique mon tableau

je vous remercie d'avance

 

[vgendron]

Hello à tous

En utilisant l'enregistreur de macro et la fonction TRI alpha de Excel tu obtiens ce code

Sub Macro1()
'
' Macro1 Macro
'

    Range("B6:F41").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B7:F41")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("H6:L41").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("H6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("H7:L41")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("N6:R41").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("N6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("N7:R41")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[zebanx]

Bonjour Nicole, Bonjour Vgendron, Bonjour B.Lambelet

Merci pour ces codes.

@vgendron
Pas testable sans erreur sur excel 2003 (mais pas grave... je reste avec mon dinosaure pour le moment)

@Nicole
Les données de la colonne "Unité" semblent être modifiées en reprenant pour certaines lignes le nom de l'occupant. Pas compris pourquoi...(et sinon parfait!)

 

[vgendron]

@zebanx et les autres ..
pas bien grave.. car en fait. ma solution ne fait qu'un tri tableau par tableau...
la solution de Nicole est bien meilleure (et repond au besoin :-D )

 

[job75]

Bonsoir b.lambelet, Nicole, vgendron, zebanx,

Une solution simple utilisant des couper-coller :

Sub Tri()
Dim tablo1 As Range, tablo2 As Range, tablo3 As Range, ad2$, ad3$
Set tablo1 = [B6].CurrentRegion 'à adapter
Set tablo2 = [H6].CurrentRegion 'à adapter
Set tablo3 = [N6].CurrentRegion 'à adapter
ad2 = tablo2.Address: ad3 = tablo3.Address 'mémorisation
Application.ScreenUpdating = False
tablo2.Cut tablo1(tablo1.Rows.Count + 1, 1)
tablo3.Cut tablo2(tablo2.Rows.Count + 1, 1)
Range(tablo1, tablo3).Sort tablo1(1, 2), xlAscending, Header:=xlNo  'tri croissant sur les noms
tablo2.Cut Range(ad2): tablo3.Cut Range(ad3)
End Sub

Elle suppose qu'il n'y a rien sous le 1er tableau.

Fichier joint.

A+

 

[job75]

Re,

Voyons maintenant la question des couleurs de fond (alternées) des lignes des tableaux.

Dans le fichier original ce sont des couleurs réelles, ce qui n'est pas du tout génial.

En effet c'est lourd à mettre en œuvre, et dans mon fichier précédent, lors du tri, les couleurs suivent, ce qui perturbe leur alternance.

Il faut bien sûr appliquer une MFC aux 3 tableaux pour obtenir l'alternance des couleurs.

Alors il n'y a plus de problème car la MFC ne suit pas le tri.

Fichiers (2).

A+

 

[job75]

Re,

Ah oui reste l'histoire des lettres en 1ère colonne mais ce n'est pas un problème :

Sub Tri()
Dim tablo1 As Range, tablo2 As Range, tablo3 As Range, ad2$, ad3$
Set tablo1 = [B6].CurrentRegion 'à adapter
Set tablo2 = [H6].CurrentRegion 'à adapter
Set tablo3 = [N6].CurrentRegion 'à adapter
ad2 = tablo2.Address: ad3 = tablo3.Address 'mémorisation
Application.ScreenUpdating = False
tablo2.Cut tablo1(tablo1.Rows.Count + 1, 1)
tablo3.Cut tablo2(tablo2.Rows.Count + 1, 1)
With Range(tablo1, tablo3)
  .Sort .Columns(2), xlAscending, Header:=xlNo  'tri croissant sur les noms
  .Columns(1) = "=IF(LEFT(RC[1])=LEFT(R[-1]C[1]),"""",UPPER(LEFT(RC[1])))" 'lettre en 1ère colonne
  .Columns(1) = .Columns(1).Value
End With
tablo2.Cut Range(ad2): tablo3.Cut Range(ad3)
End Sub

Fichiers (3).

Bonne nuit.

 

[job75]

Re,

Avant d'aller dormir juste une remarque.

Avec le code que j'ai donné il ne faut pas de lignes vides en bas du 1er et du 2ème tableau, ni bien sûr de lignes vides coupant les tableaux.

S'il y en avait on utiliserait alors tout simplement :

Set tablo1 = [B6:F41] 'à adapter
Set tablo2 = [H6:L41] 'à adapter
Set tablo3 = [N6:R41] 'à adapter

Re-bonne nuit.

 

[b.lambelet]

Magnifique , je vous remercie tous pour le tableau,
Est-il possible d'ajouter une colonne à la suite la colonne nommée " CH " avec les même fonction de tri

Encore un immense merci

 

[job75]

Bonjour le forum,

Avec cette solution plus générale le nombre des tableaux peut être quelconque :

Sub Tri()
Dim nom As Name, n%, liste$(), tablo As Range, P As Range
'---liste des noms des tableaux et de leurs adresses---
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Tableau#*" Then
    ReDim Preserve liste(1, n) 'base 0
    liste(0, n) = nom.Name
    liste(1, n) = Range(nom.Name).Address
    n = n + 1
  End If
Next
'---groupement des tableaux les uns en dessous des autres---
Application.ScreenUpdating = False
Set tablo = Range(liste(0, 0))
Set P = tablo
For n = 1 To UBound(liste, 2)
  Range(liste(0, n)).Cut tablo(tablo.Rows.Count + 1, 1) 'couper-coller
  Set tablo = Range(liste(0, n))
  Set P = Range(P, tablo)
Next
'---tri et lettre en 1ère colonne---
P.Sort P(1, 2), xlAscending, Header:=xlNo 'tri croissant sur les noms
P.Columns(1) = "=IF(LEFT(RC[1])=LEFT(R[-1]C[1]),"""",UPPER(LEFT(RC[1])))"
P.Columns(1) = P.Columns(1).Value 'supprime les formules
'---remise en place des tableaux---
For n = 1 To UBound(liste, 2)
  Range(liste(0, n)).Cut Range(liste(1, n)) 'couper-coller
Next
With P.Parent.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Conditions :

- les plages des tableaux doivent être nommées dans l'ordre Tableau01, Tableau02, Tableau03 etc...

- les tableaux doivent avoir bien sûr le même nombre de colonnes, qui peut être quelconque.

Le nombre de lignes de chaque tableau n'a aucune importance.

Fichiers (4).

Bonne journée.

 

[zebanx]

Bonjour Job75, Nicole, B.Lambelet et le forum

Bravo pour ces compléments.

@job75
Il y a eu un problème d'importation de tes fichiers semble-t-il, on ne peut les ouvrir.

Sinon, ce serait bien plus simple (mais moins fun pour deux des illustres codeurs du site !) de prévoir un tableau en BDD (x lignes et 5 colonnes avec 1ère ligne vide pour la saisie et tri automatique) et de spliter ensuite par groupe de N.lignes (avec un step).

 

[job75]

Re zebanx,

Avec ma méthode des couper-coller les tableaux ne doivent pas être des tableaux Excel.

Cette méthode est environ 2 fois plus rapide que la méthode utilisée par Nicole.

La durée d'exécution est proportionnelle au nombre de tableaux, chez moi sur Win 10 Excel 2013 :

- 3 tableaux 5 x 36 => 0,06 seconde

- 4 tableaux 5 x 36 => 0,08 seconde

- 5 tableaux 5 x 36 => 0,10 seconde.

Je redépose les fichiers (4)...

A+

 

[zebanx]

Merci Job75.

Du super code, comme d'habitude (et de même pour N.B.)

L'utilisation de Range(tablo1, tablo3), des adresses initiales avec le cut et pour la dernière partie la méthodologie d'enregistrement des noms pour pouvoir les utiliser sont des approches intéressantes et on peut bien voir le en pas à pas détaillé (avec quelques debug.print à regarder pour ma part encore).
Pour Nicole, le code est plus compliqué d'approche.

Mais merci à tous les deux d'avoir poussé le raisonnement à "x" tableaux.
Une sauvegarde s'impose, comme très souvent !

bonne journée
zebanx

 

[job75]

Re,

Je reviens sur les MFC car l'ami b.lambelet ne les connaît peut-être pas bien.

Voyez ces fichiers (5) : les lignes de l'année en cours sont colorées en bleu par les MFC.

On vérifiera sur chaque tableau que le tri les conserve sans aucune modification.

A+