Multi-tri conditionnel avec recopie

Invité · 15/03/2016, 22h36

Bonjour à tous !

Je peine depuis plusieurs jours sur le problème suivant :

Je souhaite, à partir d'un tableau faire un tri sur la colonne Criticité et recopier les 5 lignes dont les valeurs de Criticité sont les plus grandes du tableau sur une autre partie de la feuille (le tableau supérieur).
L'idée générale est de simplement isoler ces lignes pour les exporter facilement.

Dans un second temps, j'aimerai - en cas d'égalité sur la colonne Criticité - faire le même tri sur la colonne Probabilité, puis sur la colonne Montant.
Mais à priori le code sera le même que pour le premier tri. Ai-je tord ?

La recopie de la ligne sur laquelle on trouve la criticité maximale est bien recopié sur la ligne 7. Mais également sur les 4 autres lignes.
J'aimerai savoir comment je pourrais modifier ce code afin d'obtenir le résultat escompté.

Je suppose qu'il faut éliminer la valeur MAX de la colonne criticité pour laquelle la ligne est déjà écrite. Mais comment faire ?

Bonne soirée à vous !

Invité · 16/03/2016, 06h12

Bonjour,

S'il s'agit de récupérer les criticités avec doublons, les macros suivantes peuvent faire l'affaire :

La macro trie le tableau dans l'ordre décroissant des 3 champs indiqués, récupère les cinq premières lignes et trie le tableau dans l'ordre des identifiants.

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 TestCinqMeilleuresCriticites()
 
    CinqMeilleuresCriticites Sheets("Feuil1"), 39, 7
 
End Sub
 
Sub CinqMeilleuresCriticites(ByVal FeuilleATrier As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneDeDestination As Long)
 
Dim DerniereLigne As Long
Dim DerniereColonne As Long
 
 
Dim AireTableau As Range
Dim AireIdentifiant As Range
Dim AireCriticite As Range
Dim AireProbabilite As Range
Dim AireMontant As Range
 
    With FeuilleATrier
 
         DerniereLigne = .Cells(.Rows.Count, 2).End(xlUp).Row
         DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
 
         Set AireTableau = .Range(.Cells(LigneDeTitre, 2), .Cells(DerniereLigne, DerniereColonne))
         Set AireIdentifiant = .Range(.Cells(LigneDeTitre, 2), .Cells(DerniereLigne, 2))
         Set AireCriticite = .Range(.Cells(LigneDeTitre, 5), .Cells(DerniereLigne, 5))
         Set AireMontant = .Range(.Cells(LigneDeTitre, 6), .Cells(DerniereLigne, 6))
         Set AireProbabilite = .Range(.Cells(LigneDeTitre, 7), .Cells(DerniereLigne, 7))
 
 
         ' Tri par ordre décroissant des champs Criticité, Probabilité, Montant
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=AireCriticite, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
         .Sort.SortFields.Add Key:=AireProbabilite, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
         .Sort.SortFields.Add Key:=AireMontant, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
         With .Sort
              .SetRange AireTableau
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
         End With
 
         ' Copie des 5 premières lignes du tableau trié
         If AireTableau.Rows.Count > 5 Then
            AireTableau.Rows("2:6").Copy Destination:=.Cells(LigneDeDestination, 2)
         End If
 
         ' Tri par ordre croissant des identifiants
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=AireIdentifiant, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .Sort
              .SetRange AireTableau
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
         End With
 
 
         Set AireTableau = Nothing
         Set AireIdentifiant = Nothing
         Set AireCriticite = Nothing
         Set AireMontant = Nothing
         Set AireProbabilite = Nothing
 
 
    End With
 
End Sub

Cordialement.