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** · 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** · 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

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

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

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

Je te remets les images dans l'ordre:

Image 1: J affecte mes numéros en colonne A
Image 2 : J e démasque mes lignes avec la macro AFFICHE.Pour vérifier que le numéro affecté soit reporté sur les sous lignes via les formules (colonne A sous groupes =colonne A ligne principale)
Image 3: Je trie avec la macro tri.Et la ça bugge!!

**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

**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** · 11/05/2016, 08h08

Je trie avec la macro tri. Et la ça bugge!

je ne vois pas de bug sur mon fichier, essayes celui-ci auquel j'ai mis des numéros au hasard en A, pour chaque marque

les ingrédients sont triés par marque et les marques sont triées par ordre alphabétique (col B)

**veevv** · 11/05/2016, 21h05

Bonsoir,

Parfaiiiiit,on y presque.Juste 3 choses :-quand je masque les sous lignes, le tri ne fonctionne plus et il me met le bug (voir image)
-quand je change plusieurs l'ordre des numéros le tri fonctionne plus
-est-il possible de mettre un tri croissant par code article (colonne f) quand il n'y a aucun numéro en colonne A.

Voila le bug quand les lignes sont masquées

**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** · 11/05/2016, 22h15

bonsoir,
pour ton premier problème

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
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
ActiveSheet.UsedRange.EntireRow.Hidden = False
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:=Cells(5, Dcol + 1) '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
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
Masque_lg_230
End Sub