Macro ordonnancement excel

Version imprimable

Voir 40 message(s) de cette discussion en une page

1 pièce(s) jointe(s)

Macro ordonnancement excel

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:

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

30/04/2016, 15h00
casefayere

Bonjour,

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

Mot passe le chiffre 0

Oui désolé le mot de passe est le chiffre 0
30/04/2016, 16h20
casefayere

ou est ton sous groupe, en colonne J ?
si oui auras-tu toujours cette cellule en début de groupe "Voir Traçabilité"
30/04/2016, 16h59
veevv

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é.
30/04/2016, 22h27
clementmarcotte

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

Project Libre

Gantt Project

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:

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:

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

tri par bloc après quelques investigations

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:

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:

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:

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:

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

02/05/2016, 21h49
veevv

Merci beaucoup césar ça marche.Dsl d'avoir publier sur plusieurs forums.J'en avais vraiment vraiment besoin.
07/05/2016, 20h09
veevv

Salut casefayere,

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

Code:

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
09/05/2016, 13h15
casefayere

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.)
09/05/2016, 19h29
veevv

1 pièce(s) jointe(s)

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

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:

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

Code:

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:

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:

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"

09/05/2016, 21h40
veevv

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.
09/05/2016, 21h54
casefayere
1ère chose :
si tu es amené à changer le nombre de colonnes dans ton tableau, remplaces cette ligne de mon code

Code:

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:

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:

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
09/05/2016, 22h25
veevv

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.
09/05/2016, 22h49
casefayere

1 pièce(s) jointe(s)

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
09/05/2016, 22h52
veevv

OK a demain

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

Code:

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:

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:

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

10/05/2016, 21h23
veevv

3 pièce(s) jointe(s)

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

Voir 40 message(s) de cette discussion en une page