Macro ordonnancement excel

**veevv** · 30/04/2016, 14h46

Bonjour,

J'ai un souci au niveau d'une macro.J'ai un première onglet (sur le classeur : onglet sans sous groupe) où j'ai mis une macro avec le tri des lignes d'un tableau par ordre croissant en fonction d'une cellule où j'ai affecté des numéros.Le tri fonctionne très bien.Avec la fonction suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Rows("5:16").Select
Selection.Sort Key1:=Range("F5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select

J'ai rajouté des sous lignes (onglet avec sous groupe) associés a la première ligne où j'affecte un numéro aussi.J'aimerai que le tri se fasse en prenant en compte les sous groupes.Mais quand je tri il y a un soucis à cause des sous groupes.

Je vous joins le fichier pour que ça soit plus clair.

Merci d'avance

**casefayere** · 30/04/2016, 15h00

Bonjour,

pour une rare fois où je me résigne à ouvrir un fichier, il faut un mot de passe et n'étant pas devin.........

**veevv** · 30/04/2016, 15h28

Oui désolé le mot de passe est le chiffre 0

**casefayere** · 30/04/2016, 16h20

ou est ton sous groupe, en colonne J ?
si oui auras-tu toujours cette cellule en début de groupe "Voir Traçabilité"

**veevv** · 30/04/2016, 16h59

Oui mon sous groupe est en colonne J.J'aurai toujours cette colonne traçabilité.Car en fait le fichier excel avec les sous groupe est pour moi.Ensuite je masque les sous groupes et j'imprime la feuille.Sur le terrain,si ils ne savent pas de quoi se compose la salade ils doivent regarder leur fiche de traçabilité.

**clementmarcotte** · 30/04/2016, 22h27

Deux programmes gratuits pour gérer des projets comme du monde:

Project Libre

Gantt Project

**casefayere** · 01/05/2016, 03h31

re,
pour trier tes sous groupes, je te propose ces codes, au vu de ton exemple et en estimant que tu as déjà mis dans l'ordre tes groupes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub etablir()
Dim Dcol As Long, Dcel As Range, i As Long, Tb()
Dim A_trier As Range, x As Long
ReDim Tb(1 To 1)
x = 0
With Feuil3
  Dcol = .Cells(5, .Columns.Count).End(xlToLeft).Column
  Set Dcel =.Cells(.Rows.Count, Dcol).End(xlUp)
  For i = 5 To Dcel.Row
    If LCase(.Cells(i, Dcol).Value) = "voir traçabilité" Then
      x = x + 1
      ReDim Preserve Tb(1 To x)
      Tb(x) = .Cells(i, Dcol).Address
    End If
  Next
  For i = 1 To UBound(Tb) - 1
    Set A_trier = .Range(.Range(Tb(i))(2, -Dcol + 2), .Range(Tb(i + 1))(0, 1))
    tri A_trier, .Range(Tb(i))(2, 1)
  Next i
  Set A_trier = .Range(.Range(Tb(UBound(Tb)))(2, -Dcol + 2), Dcel)
  tri A_trier, .Range(Tb(UBound(Tb)))(2, 1)
 
End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub tri(laplage As Range, lacel As Range)
laplage.Sort Key1:=lacel, Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End Sub

**casefayere** · 01/05/2016, 19h16

Bonjour,
je viens de trouver une solution qui trie (en respectant le fichier que tu as envoyé) le tout
un bouton (contrôle ActiveX) sur la feuille avec ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub CommandButton1_Click()'voir le nom du bouton
Application.ScreenUpdating = False
etablir
Application.ScreenUpdating = True
End Sub

en haut d'un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Option Explicit
Dim Dcol As Long, Dcel As Range, i As Long, Tb()
Dim x As Long

coller dessous ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub etablir()
Dim A_trier As Range, ListeNoms As Object, Nom As String
Nom = ""
Set ListeNoms = CreateObject("System.Collections.ArrayList") ' un "Arraylist pour trier plus facilement en bas du module
ReDim Tb(1 To 1) 'j'initialise une variable tableau
x = 0
Dcol = Cells(5, Columns.Count).End(xlToLeft).Column ' on cherche la dernière colonne
Set Dcel = Cells(Rows.Count, Dcol).End(xlUp) 'et la dernière cellule dans cette colonne
For i = 5 To Dcel.Row 'on boucle sur cette colonne
  If LCase(Cells(i, Dcol).Value) = "voir traçabilité" Then 'on vérifie la cellule
    x = x + 1 'si vérifié, on incrémente x
    ReDim Preserve Tb(1 To x) 'on redimensionne le tableau
    Tb(x) = Cells(i, Dcol).Address 'et on donne l'adresse à l'élément du tableau
  End If
Next i
For i = 1 To UBound(Tb) - 1 'on boucle sur le tableau
  Set A_trier = Range(Range(Tb(i))(2, -Dcol + 2), Range(Tb(i + 1))(0, 1)) 'plage qui sera triée
  tri A_trier, Range(Tb(i))(2, 1) 'on va sur la procédure tri
  Nom = Split(Range(Tb(i))(1, -Dcol + 3), " ")(1) 'nom représente le mot après "Marque"
  ActiveWorkbook.Names.Add Name:=Nom, RefersTo:= _
      Range(Range(Tb(i))(1, -Dcol + 2), Range(Tb(i + 1))(0, 1)) 'on définit un nom pour la plage triée
  ListeNoms.Add Nom 'on ajoute ce nom à une "ArrayList"
Next i
  'ci-dessous pour le dernier groupe
Set A_trier = Range(Range(Tb(UBound(Tb)))(2, -Dcol + 2), Dcel)
tri A_trier, Range(Tb(UBound(Tb)))(2, 1)
Nom = Split(Range(Tb(UBound(Tb)))(1, -Dcol + 3), " ")(1)
ActiveWorkbook.Names.Add Name:=Nom, RefersTo:= _
      Range(Range(Tb(UBound(Tb)))(1, -Dcol + 2), Dcel)
ListeNoms.Add Nom
'---------------------------------------------------------------
Range(ListeNoms(0)).Cut Destination:=Range("K5") 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne
  'et les autres au travers d'une boucle
For i = 1 To ListeNoms.Count - 1
  Set Dcel = Cells(Rows.Count, Dcol * 2).End(xlUp)(2, -Dcol + 2)
  Range(ListeNoms(i)).Cut Destination:=Dcel
Next i
  '-------------------------------------------------------------
ListeNoms.Sort 'on trie les noms des blocs
Range(ListeNoms(0)).Cut Destination:=Range("A5") 'on remet le 1er bloc au début
  'et les autres au travers d'une boucle
For i = 1 To ListeNoms.Count - 1
  Set Dcel = Cells(Rows.Count, Dcol).End(xlUp)(2, -Dcol + 2)
  Range(ListeNoms(i)).Cut Destination:=Dcel
Next i
End Sub

et enfin celui-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub tri(laplage As Range, lacel As Range)
laplage.Sort Key1:=lacel, Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End Sub

ça vaut ce que ça vaut mais trier des blocs n'est pas évident pour moi

**veevv** · 02/05/2016, 21h49

Merci beaucoup césar ça marche.Dsl d'avoir publier sur plusieurs forums.J'en avais vraiment vraiment besoin.

**veevv** · 07/05/2016, 20h09

Salut casefayere,

J'ai un message d'erreur "la méthode range_global de l'objet a échoué" sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set A_trier = Range(Range(Tb(UBound(Tb)))(2, -Dcol + 2), Dcel)

Peut-être que j'ai du mal copié le code.
Tu n'avais pas cette erreur?

CDT

**casefayere** · 09/05/2016, 13h15

Bonjour le forum, veevv,
j'étais absent tous ces derniers jours et n'ai donc pas pu suivre les discussions.

En l'état, je ne peux te répondre car j'ai personnellement testé ma proposition sans rencontrer de bug.

Peux-tu renvoyer tous tes codes , es-tu passé, comme je l'ai suggéré par un bouton ? sinon penser à indiquer les feuilles concernées avec des "With" et "." devant les objets (.Range, .Cells, .Row, .Column, etc.)

**veevv** · 09/05/2016, 19h29

Oui j'ai remplacé le code de mon bouton "tri 230" avec les flèches vert,bleu,rouge en haut de la feuille excel.Dans l'instruction que tu m'as donné j'ai peut-être loupé qqchose.Je te renvois le fichier source .Dis moi ce que tu en penses?

Voila le fichier avec les modifs

**casefayere** · 09/05/2016, 20h19

il est normal que tu aies des bug, ton fichier n'a plus la même configuration qu'au départ, tu allais jusqu'à la colonne "J", maintenant c'est la colonne "I".

d'après ton dernier fichier, voici ce que tu dois écrire en module1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Option Explicit
Dim Dcol As Long, Dcel As Range, i As Long, Tb()
Dim x As Long

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub tri_ss_gr_Click() 'voir le nom du bouton
Application.ScreenUpdating = False
etablir
Application.ScreenUpdating = True
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub etablir()
Dim A_trier As Range, ListeNoms As Object, Nom As String, Ingd As String
Nom = ""
Set ListeNoms = CreateObject("System.Collections.ArrayList") ' un "Arraylist pour trier plus facilement en bas du module
ReDim Tb(1 To 1) 'j'initialise une variable tableau
x = 0
Dcol = Cells(5, Columns.Count).End(xlToLeft).Column ' on cherche la dernière colonne
Ingd = Cells(5, Dcol)
Set Dcel = Cells(Rows.Count, Dcol).End(xlUp) 'et la dernière cellule dans cette colonne
For i = 5 To Dcel.Row 'on boucle sur cette colonne
  If Cells(i, Dcol).Value = Ingd Then 'on vérifie la cellule
    x = x + 1 'si vérifié, on incrémente x
    ReDim Preserve Tb(1 To x) 'on redimensionne le tableau
    Tb(x) = Cells(i, Dcol).Address 'et on donne l'adresse à l'élément du tableau
  End If
Next i
For i = 1 To UBound(Tb) - 1 'on boucle sur le tableau
  Set A_trier = Range(Range(Tb(i))(2, -Dcol + 2), Range(Tb(i + 1))(0, 1)) 'plage qui sera triée
  tri A_trier, Range(Tb(i))(2, 1) 'on va sur la procédure tri
  Nom = Split(Range(Tb(i))(1, -Dcol + 3), " ")(1) 'nom représente le mot après "Marque"
  ActiveWorkbook.Names.Add Name:=Nom, RefersTo:= _
      Range(Range(Tb(i))(1, -Dcol + 2), Range(Tb(i + 1))(0, 1)) 'on définit un nom pour la plage triée
  ListeNoms.Add Nom 'on ajoute ce nom à une "ArrayList"
Next i
  'ci-dessous pour le dernier groupe
Set A_trier = Range(Range(Tb(UBound(Tb)))(2, -Dcol + 2), Dcel)
tri A_trier, Range(Tb(UBound(Tb)))(2, 1)
Nom = Split(Range(Tb(UBound(Tb)))(1, -Dcol + 3), " ")(1)
ListeNoms.Add Nom
ActiveWorkbook.Names.Add Name:=Nom, RefersTo:= _
      Range(Range(Tb(UBound(Tb)))(1, -Dcol + 2), Dcel)
'---------------------------------------------------------------
Range(ListeNoms(0)).Cut Destination:=Range("J5") 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne
  'et les autres au travers d'une boucle
For i = 1 To ListeNoms.Count - 1
  Set Dcel = Cells(Rows.Count, Dcol * 2).End(xlUp)(2, -Dcol + 2)
  Range(ListeNoms(i)).Cut Destination:=Dcel
Next i
  '-------------------------------------------------------------
ListeNoms.Sort 'on trie les noms des blocs
Range(ListeNoms(0)).Cut Destination:=Range("A5") 'on remet le 1er bloc au début
  'et les autres au travers d'une boucle
For i = 1 To ListeNoms.Count - 1
  Set Dcel = Cells(Rows.Count, Dcol).End(xlUp)(2, -Dcol + 2)
  Range(ListeNoms(i)).Cut Destination:=Dcel
Next i
End Sub
Private Sub tri(laplage As Range, lacel As Range)
laplage.Sort Key1:=lacel, Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End Sub

je ne t'envoies pas de fichier pour l'instant car je veux comprendre ce que tu veux comme tri avec ce genre de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Tri230()
    Rows("5:50").Select
    Selection.Sort Key1:=Range("F5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
End Sub

déjà, eviter les "Select", ensuite à quoi sert de trier sur "F5" si tu recommences avec "A5"

**veevv** · 09/05/2016, 21h40

Ok.En fait j'ai simplifié le fichier à 5 marques mais j'ai plus de 50 marques.Voila comment je procède.Avant d'affecter les numéros en colonne A ,je recherche toutes les références que je dois ordonner (pas toutes).Car il s'agit d'une feuille standard avec tous les marques.Et le tri croissant par code article me permet de trouver plus rapidement mes références pour leur affecter un numéro.

**casefayere** · 09/05/2016, 21h54

1ère chose :
si tu es amené à changer le nombre de colonnes dans ton tableau, remplaces cette ligne de mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(ListeNoms(0)).Cut Destination:=Range("J5") 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne

par celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(ListeNoms(0)).Cut Destination:=Cells(5, Dcol + 1) 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne

2ème chose : j'espère que tu as vu pourquoi j'ai ajouté une variable pour ces lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
......
Ingd = Cells(5, Dcol)......
  If Cells(i, Dcol).Value = Ingd Then 'on vérifie la cellule

3ème chose : je ne comprends pas tes explications pour les tris que j'estime alambiqués mais ça reste ton problème car non prévu dans la demande
dis-moi au moins si ma dernière version fonctionne

**veevv** · 09/05/2016, 22h25

J'ai mis le tri en colonne F,uniquement quand la colonne A est vide.Imaginons que j'affecte que 2 numéros (exemple 1 : en colonne A pour la marque Leclerc et 2 pour la marque Carrefour) et rien en colonne A sur les autres marques.En faisant mon tri,il mettra en 1 la marque Leclerc et en 2 la marque Carrefour.Les autres marques ayant aucun numéro affectées en colonne A seront triées par tri croissant en fonction de leur code article en colonne f.

J'ai essayé ton code.Il trie bien les numéros les lignes auxquelles j'ai affecté un numéro.Mais pas les autres.Peux tu m'envoyer le fichier stp si ça fonctionne chez toi.
Je suis désolé si je suis pas clair.

**casefayere** · 09/05/2016, 22h49

voila le fichier sur lequel je me suis basé et qui correspond à ta demande du départ, sur celui-ci je n'ai pas touché à tes procédures de tri, juste un peu à celle de ThisWorkbook
pour tes futures demandes, je ne serai libre que demain soir (c'est ça les retraites), quelqu'un d'autre sera peut-être disponible avant moi,

bonne nuit

**veevv** · 09/05/2016, 22h52

OK a demain

**casefayere** · 09/05/2016, 23h01

un détail, j'ai oublié d'enregistrer avec cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(ListeNoms(0)).Cut Destination:=Cells(5, Dcol + 1) 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne

qui remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(ListeNoms(0)).Cut Destination:=Range("J5") 'on déplace la 1ère plage (1er bloc) à droite de la dernière colonne

encore une petite modif en fin de procédure "etablir"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
  '-------------------------------------------------------------
ListeNoms.Sort 'on trie les noms des blocs
'Range(ListeNoms(0)).Cut Destination:=Range("A5") 'on remet le 1er bloc au début
  'et les autres au travers d'une boucle
Set Dcel = Range("A5")
For i = 0 To ListeNoms.Count - 1
  Range(ListeNoms(i)).Cut Destination:=Dcel
  Set Dcel = Cells(Rows.Count, Dcol).End(xlUp)(2, -Dcol + 2)
Next i

**veevv** · 10/05/2016, 21h23

Voila j'ai mis des imprim écran pour détailler le soucis.Dis moi ce que t'en penses.

Macro ordonnancement excel [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager