Macro Excel tri personnalisé

**romain8544** · 03/06/2016, 11h10

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

**Marc-L** · 03/06/2016, 11h23

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, …

**romain8544** · 03/06/2016, 12h33

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

**Marc-L** · 03/06/2016, 12h52

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) …

**Kiouane** · 03/06/2016, 15h15

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

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

**romain8544** · 06/06/2016, 08h01

ça l'air de marcher. Merci beaucoup à vous deux.
Je teste la macro dans la journée et je reviens vers vous.

**romain8544** · 06/06/2016, 11h33

Je viens de changer les valeurs du tableau, pour tester, mais ça ne fonctionne pas à chaque fois!

**Kiouane** · 06/06/2016, 13h47

Tu peux me montrer le nouveau tableau?

**romain8544** · 06/06/2016, 13h51

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.

**Kiouane** · 06/06/2016, 13h54

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

**romain8544** · 06/06/2016, 13h58

oui j'ai mis le 30

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

**Kiouane** · 06/06/2016, 14h06

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 :

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

**romain8544** · 06/06/2016, 14h45

ça marche nickel!

Merci beaucoup pour ton aide.

**romain8544** · 09/06/2016, 13h13

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 :

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

**Kiouane** · 09/06/2016, 15h23

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.

**romain8544** · 09/06/2016, 15h43

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.

**Kiouane** · 09/06/2016, 15h48

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.

**romain8544** · 09/06/2016, 16h19

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

Les cellules en JAUNE sont celles qui n'ont pas suivi leur ligne.

**Kiouane** · 09/06/2016, 16h29

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?

**romain8544** · 09/06/2016, 16h46

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".

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 .

Macro Excel tri personnalisé [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager