Lister les 15 plus petites valeurs

[xerios123]

bonjour,
Je souhaite réaliser un code qui permet de lister dans une listebox les 15 plus petites valeurs qui sont rangées dans les colonnes N , S, X, AC, AH et AM

Il s'agit d'un nombre de jour qu'une opération soit finit. Dans une ligne il peut contenir 6 opérations

J'aimerai quil recherche dans tous le classeur, les valeurs les plus petites par exemple :

ligne5 : opération 3 5jours
Ligne 85 : opération 1 6jours
Ligne5 : opération2 8jours



Voici mon code :
Private Sub ok_Click()

Worksheets(3).Activate
Dim myrange As Range
Dim startX As Variant

' recherche la valeur la plus petite
With Worksheets("preventive")
Set myrange = Union(.Columns("N:N"), .Columns("S:S"), .Columns("X:X"), .Columns("AC:AC"), .Columns("AH:AH"), .Columns("AM:AM"))
startX = Application.WorksheetFunction.Min(myrange)
End With

' localise la valeur la plus petite et renvoie un message
For Each cell In myrange.Cells
If cell.Value = startX Then
MsgBox "La plus petite valeur est " & startX & " ligne n°" & cell.Row & " et colonne n°" & cell.Column
Exit For
End If
Next

Me.ListBox1.Clear
Me.ListBox1.AddItem
Me.ListBox1.List(0, 0) = Worksheets(3).Cells(cell.Row, 2).Value 'Famille
Me.ListBox1.List(0, 1) = Worksheets(3).Cells(cell.Row, 8).Value ' matériels
Me.ListBox1.List(0, 2) = Worksheets(3).Cells(cell.Row, cell.Column - 4).Value
Me.ListBox1.List(0, 3) = Worksheets(3).Cells(cell.Row, cell.Column - 3).Value
Me.ListBox1.List(0, 4) = Worksheets(3).Cells(cell.Row, cell.Column - 1).Value
Me.ListBox1.List(0, 5) = startX ' jour le plus faible

Worksheets(1).Activate


End Sub



Ce code me renvoie uniquement la première valeur, comment faire pour quil me renvoie les 15 suivantes?




merci de votre aide

 

[pierrejean]

Re : Lister les 15 plus petites valeurs

Bonjour Xerios

Par chance ton problème m'a paru interessant , si bien que j'ai fait ce que tu aurais du faire ( à savoir un fichier exemple)
Vois si cela te convient
Attention: Faire une copie de la feuille preventive avant de faire des tests : En cas de Bug les valeurs peuvent avoir été modifiées

 

[xerios123]

Re : Lister les 15 plus petites valeurs

bonjour

Merci de votre aide, il va me falloir un peu de temps avant de comprendre votre code...

Je vous recontacte si sa marche !

Merci

 

[xerios123]

Re : Lister les 15 plus petites valeurs

je n'arrive pas à comprendre le code, quelles sont les variables qui identifie le numéro de ligne et le numéro de colonne?
Je ne peut afficher mes valeurs dans les listeboxs sans sa

 

[pierrejean]

Re : Lister les 15 plus petites valeurs

Re

Suite à MP le code commenté

Sub ok_Click()
'Worksheets(3).Activate
Dim myrange As Range
Dim startX As Variant
''''declaration d'un tableau destiné a recevoir les resultats
ReDim tabres(1 To 2, 1 To 1)
With Worksheets("preventive")
Set myrange = Union(.Columns("N:N"), .Columns("S:S"), .Columns("X:X"), .Columns("AC:AC"), .Columns("AH:AH"), .Columns("AM:AM"))
'cherche la plus grand valeur dans myrange
  plusgrand = Application.WorksheetFunction.Max(myrange)
'tant que le tableau de resultat n'atteint pas 16 valeurs
While UBound(tabres, 2) < 16
'''' recherche la valeur la plus petite
  startX = Application.WorksheetFunction.Min(myrange)
'''recherche de la cellule contenant la plus petite valeur (voir aide sur Find)
  Set c = myrange.Find(startX, LookIn:=xlValues, lookat:=xlWhole)
  '''' mise en tableau resultat de la plus petite valeur et de son adresse
  tabres(1, UBound(tabres, 2)) = startX
  tabres(2, UBound(tabres, 2)) = c.Address
  '''''
  'Remplacement dans cette cellule par la plus grande valeur augmentée de 1
  'pour que la recherche suivante s'opere sur la  + petite valeur suivante
  c.Value = plusgrand + 1
  'augmentation de la taille du tableau resultat pour accueillir la prochaine valeur
  ReDim Preserve tabres(1 To 2, 1 To UBound(tabres, 2) + 1)
Wend
End With
msg = "plus petites valeurs : "
'pour chaque valeur du tableau resultat
For n = 1 To UBound(tabres, 2) - 1
  'restituer la valeur d'origine aux cellules contenant les plus petites valeurs
  Sheets("preventive").Range(tabres(2, n)) = tabres(1, n)
  'ecrire le message
  msg = msg & tabres(1, n) & " ; "
Next
'affiche la liste des 15 plus petites valeurs
MsgBox (Left(msg, Len(msg) - 2))
End Sub