Macro Excel tri personnalisé

Version imprimable

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

03/06/2016, 11h10
romain8544

1 pièce(s) jointe(s)

Macro Excel tri personnalisé

Bonjour,
je souhaite faire une macro de tri personnalisé sous excel.

Dans toutes mes cellules ce sont des nombres.
Ma colonne B doit être trié par ordre décroissant

après le tri, je veux contrôler:
- que dans ma colonne A la ligne contenant "10" soit obligatoirement après toutes c'est cellules "1,2,3,4,5,6,7,8,9" sinon déplacer après la derrière de la liste "2,3,4,5,6,7,8,9"
- que dans ma colonne A la ligne contenant "20" soit obligatoirement après toutes c'est cellules "11,12,13,14,15,16,17,18,19" sinon déplacer après la derrière de la liste "11,12,13,14,15,16,17,18,19" .

Merci de votre aide
03/06/2016, 11h23
Marc-L

Bonjour,

aucun souci de tri en manuel si les options sont bien paramétrées (décroissant, pas de titre de colonne)
et en activant l'Enregistreur de macros une base de code est livrée sur un plateau !

Ou encore tout simplement en lisant l'aide VBA de la méthode Range.Sort …

_________________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …
03/06/2016, 12h33
romain8544

1 pièce(s) jointe(s)

MERCI

J'ai essayer un tri personnalisé par niveau mais ça ne marche pas avec la colonne A.

Voici une deuxième feuille excel pour mieux comprendre.

colonne AB= base donnée
colonne DE= après un tri de la colonne B
colonne GH= c'est que je cherche à réaliser déplacer la ligne 10 après 1,2,...,9 et 20 après 11,12,...,19
03/06/2016, 12h52
Marc-L

Oui alors là ce n'est plus une logique de tri Excel !

Il suffit de parcourir les cellules depuis la dernière (voir l'aide VBA de For … Next avec l'option Step -1) …

Je peux te proposer une solution mais il y aura sûrement mieux.

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
Sub x()
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
 
 Range("A3:B" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
 
 For j = 1 To 20
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 10 And Cells(i + 1, 1).Value < 10 Then
         a = Cells(i, 1).Offset(0, 1).Value
         Cells(i, 1).Value = Cells(i + 1, 1).Value
         Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
         Cells(i + 1, 1).Value = 10
         Cells(i + 1, 1).Offset(0, 1).Value = a
     End If
 
  Next
 
 Next
 
For j = 3 To n - 1
  For i = n - 1 To 3 Step -1
 
    If Cells(i, 1).Value = 20 And Cells(i + 1, 1).Value < 20 Then
 
        b = Cells(i, 1).Offset(0, 1).Value
       Cells(i, 1).Value = Cells(i + 1, 1).Value
       Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
       Cells(i + 1, 1).Value = 20
       Cells(i + 1, 1).Offset(0, 1).Value = b
 
     End If
 
  Next
 
Next
 
 
End Sub

06/06/2016, 08h01
romain8544

:) ça l'air de marcher. Merci beaucoup à vous deux.
Je teste la macro dans la journée et je reviens vers vous.
06/06/2016, 11h33
romain8544

Je viens de changer les valeurs du tableau, pour tester, mais ça ne fonctionne pas à chaque fois!
06/06/2016, 13h47
Kiouane

Tu peux me montrer le nouveau tableau?
06/06/2016, 13h51
romain8544

1 pièce(s) jointe(s)

je viens de refaire un tableau

COLONNE: AB: colonne à traiter avec la macro.
COLONNE GH: ce que je souhaite avoir
COLONNE KL: donnée de base

avec la macro:
- la ligne 10 ne s'est pas déplacée
- la ligne 20 s'est déplacée mais pas au bon endroit
- la ligne 30 est bien

je ne trouve pas pourquoi cela ne marche pas.
06/06/2016, 13h54
Kiouane

As-tu modifié le code pour inclure le 30?

oui j'ai mis le 30

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
53
54
55
56
57
58
59
60
61
 
Sub x()
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
 
 Range("A3:B" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
 
 For j = 1 To 35
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 10 And Cells(i + 1, 1).Value < 10 Then
         a = Cells(i, 1).Offset(0, 1).Value
         Cells(i, 1).Value = Cells(i + 1, 1).Value
         Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
         Cells(i + 1, 1).Value = 10
         Cells(i + 1, 1).Offset(0, 1).Value = a
     End If
 
  Next
 
 Next
 
For j = 3 To n - 1
  For i = n - 1 To 3 Step -1
 
    If Cells(i, 1).Value = 20 And Cells(i + 1, 1).Value < 20 Then
 
        b = Cells(i, 1).Offset(0, 1).Value
       Cells(i, 1).Value = Cells(i + 1, 1).Value
       Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
       Cells(i + 1, 1).Value = 20
       Cells(i + 1, 1).Offset(0, 1).Value = b
 
     End If
 
  Next
 
Next
 
 For j = 3 To n - 1
  For i = n - 1 To 3 Step -1
 
    If Cells(i, 1).Value = 30 And Cells(i + 1, 1).Value < 30 Then
 
        c = Cells(i, 1).Offset(0, 1).Value
       Cells(i, 1).Value = Cells(i + 1, 1).Value
       Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
       Cells(i + 1, 1).Value = 30
       Cells(i + 1, 1).Offset(0, 1).Value = c
 
     End If
 
  Next
 
Next
End Sub

Je viens de vérifier ton fichier. Je tiens à préciser que ma macro était utilisable que si les valeurs juste en dessous de 10 par exemple étaient inférieures à 10.

Voilà j'ai optimisé la macro pour ce cas spécial de tri. En prenant en compte toutes les contraintes, voilà ce que ça donne :

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub x()
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
 
 Range("A3:B" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
 
For j = 1 To 100
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 10 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 10 Then
           a = Cells(i, 1).Offset(0, 1).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Value = Cells(i + y, 1).Offset(0, 1).Value
           Cells(i + y, 1).Value = 10
           Cells(i + y, 1).Offset(0, 1).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
For j = 3 To 100
  For i = n - 1 To 3 Step -1
 
    If Cells(i, 1).Value = 20 Then
      For z = 1 To n - i
         If Cells(i + z, 1).Value < 20 Then
         b = Cells(i, 1).Offset(0, 1).Value
         Cells(i, 1).Value = Cells(i + z, 1).Value
         Cells(i, 1).Offset(0, 1).Value = Cells(i + z, 1).Offset(0, 1).Value
         Cells(i + z, 1).Value = 20
         Cells(i + z, 1).Offset(0, 1).Value = b
       Exit For
      End If
      Next
 
     End If
 
  Next
 
Next
 
 
For j = 3 To 40
  For i = n - 1 To 3 Step -1
 
    If Cells(i, 1).Value = 30 And Cells(i + 1, 1).Value < 30 Then
 
        b = Cells(i, 1).Offset(0, 1).Value
       Cells(i, 1).Value = Cells(i + 1, 1).Value
       Cells(i, 1).Offset(0, 1).Value = Cells(i + 1, 1).Offset(0, 1).Value
       Cells(i + 1, 1).Value = 30
       Cells(i + 1, 1).Offset(0, 1).Value = b
 
     End If
 
  Next
 
Next
 
 
End Sub

PS : Un pouce vert serait le bienvenu si les réponses t'ont été utiles.

06/06/2016, 14h45
romain8544

ça marche nickel!

Merci beaucoup pour ton aide.

Bonjour,

voici un code qui fonctionnait pour colonne A et B.

J'ai rajouté 3 colonnes (C,D,E) du coup le tri for next fonctionne mais décale les valeurs uniquement les les colonnes A et B, je souhaiterais sur la ligne complète ( de A à E ).
Pouvez-vous m'aider à trouver modifier le code de KIOUANE.

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
 
Sub tri()
Application.ScreenUpdating = False
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
    Range("A3:E400").Select
    ActiveWorkbook.Worksheets("TRI").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRI").Sort.SortFields.Add Key:=Range("B3:B400"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("TRI").Sort
        .SetRange Range("A3:E400")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 
 
 
 
For j = 1 To 100
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 12 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 12 Then
           a = Cells(i, 1).Offset(0, 1).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Value = Cells(i + y, 1).Offset(0, 1).Value
           Cells(i + y, 1).Value = 12
           Cells(i + y, 1).Offset(0, 1).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
 
 
End With
 
End Sub

09/06/2016, 15h23
Kiouane

Quand tu utilises le code de quelqu'un, fait lui au moins référence et non pas dire "mon code".
Sinon fais une capture d'écran de ton nouveau tableau et ce que tu entends par la même chose pour les colonnes C,D,E.
09/06/2016, 15h43
romain8544

1 pièce(s) jointe(s)

Désolé KIOUANE, j'ai modifié mon post. C'était une façon de parler.

Du coup, je souhaiterais que toute la ligne suit après le tri de la colonne A.
09/06/2016, 15h48
Kiouane

Si tu veux juste trier la colonne A en ordre croissant, tu peux faire étendre la sélection pour les autres colonnes. Sinon poste un avant après tri pour que je cerne mieux le problème.
09/06/2016, 16h19
romain8544

1 pièce(s) jointe(s)

Voici le tableau après l'exécution de la macro.

Les cellules en JAUNE sont celles qui n'ont pas suivi leur ligne.
09/06/2016, 16h29
Kiouane

Si je résume tu veux trier la colonne B en ordre décroissant, puis trier la colonne A de telle façon à ce que 10/20/30 soient sous les valeurs qui leur sont inférieures puis étendre le tri fait sur A sur toutes les autres colonnes B-C-D-E?
09/06/2016, 16h46
romain8544

Tu as bien compris par contre j'ai changé de 10-20-30 passe à 12-23-34 par contre je suis pas sûr de la forme "étendre".

Citation:

Envoyé par Kiouane

puis étendre le tri fait sur A sur toutes les autres colonnes B-C-D-E?

EX:
Les colonnes C-D-E n'ont pas besoin d'être triée mais doit suivre sa cellule A associé avant le tri.

sur le imprim écran TEST1 avant le tri - LIGNE 14 le code (lecture de la ligne de gauche vers la droite) => 12 70000 07 000 112
après la macro la ligne doit resté 12 70000 07 000 112 .

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