VBA Application.Small et Large

Bonjour

J'ai un tableau (1 to 16,1 to 2)
1,0
2,8
3,7
4,7
5,6
6,4
...
13,1
14,1
15,3
16,2

Avec la fonction Application Small ou Large je veux chercher les 3 plus grandes valeurs et 3 plus petites valeurs du tableau sans les zéros de la COL2
Le problème c'est que si je prends les 3 premières petites ou grandes valeurs dans mon tableau je voudrais comme résultat 8,7,7,6 et 1,1,2,3 et non 8,7,6 et 0,1,2

Comment faire avec
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim I as integer Dim Tablo() 'exemple avec 16 ligne et 2 col Dim ResultatLarge() 'donc 1 a 16 Ligne et 2 col Dim ResultaPetit() Dim Nombre As Single Dim Ligne As Long for I = 1 to ubound(Tablo) 'Pour le LARGE Nombre = Application.WorksheetFunction.Large(Application.Index(Tablo, , 2), I)...... 'recherche le numéro de ligne pour la valeur trouvée Ligne = Application.Match(Nombre, Application.Index(Tablo, , 2), 0) ResultaPetit(I,1)=I ResultaPetit(I,2)=Tablo(I,Ligne) ..... next I
merci d'avance

Citation:

Envoyé par GESCOM2000

Bonjour,

A tester et à adapter :

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
Option Explicit
 
Public ListeCleValeurs As Variant, ListeElementValeurs As Variant
 
Sub OrdonnerLesValeurs(ByVal FeuilleDonnees As Worksheet, ByVal TitreLigneDonnees As Long, ByVal ColonneDonnees As Long)
 
Dim MonMessage As String
Dim CtrI As Integer, CtrJ As Integer
Dim DerniereLigneDonnees As Long
Dim Tempo1, Tempo2
 
Dim AireValeurs As Range, CelluleValeurs As Range
 
 
    On Error GoTo FinOrdonnerLesValeurs
 
    With FeuilleDonnees
 
         DerniereLigneDonnees = .Cells(.Rows.Count, ColonneDonnees).End(xlUp).Row
 
         If DerniereLigneDonnees <= TitreLigneDonnees Then
            MonMessage = "Table des données vide, fin de programme !"
            GoTo FinOrdonnerLesValeurs
         End If
 
         Set AireValeurs = .Range(.Cells(TitreLigneDonnees + 1, ColonneDonnees), .Cells(DerniereLigneDonnees, ColonneDonnees))
         ReDim ListeCleValeurs(AireValeurs.Count - 1)
         ReDim ListeElementValeurs(AireValeurs.Count - 1)
 
         CtrI = 0
         For Each CelluleValeurs In AireValeurs
              ListeCleValeurs(CtrI) = CelluleValeurs
              ListeElementValeurs(CtrI) = CelluleValeurs
              CtrI = CtrI + 1
         Next CelluleValeurs
 
 
         ' Tri des valeurs par ordre alphabétique
         '---------------------------------------
         For CtrI = LBound(ListeCleValeurs) To UBound(ListeCleValeurs) - 1
             For CtrJ = CtrI + 1 To UBound(ListeCleValeurs)
                 If ListeElementValeurs(CtrI) > ListeElementValeurs(CtrJ) Then
 
                       Tempo1 = ListeCleValeurs(CtrJ)
                       Tempo2 = ListeElementValeurs(CtrJ)
 
                       ListeElementValeurs(CtrJ) = ListeElementValeurs(CtrI)
                       ListeCleValeurs(CtrJ) = ListeCleValeurs(CtrI)
 
                       ListeCleValeurs(CtrI) = Tempo1
                       ListeElementValeurs(CtrI) = Tempo2
 
                 End If
 
              Next CtrJ
 
         Next CtrI
         Set AireValeurs = Nothing
 
    End With
 
    Exit Sub
 
 
FinOrdonnerLesValeurs:
 
  MsgBox MonMessage, vbCritical, "Recherche de la dernière ligne dans l'onglet " & FeuilleDonnees.Name
  Set AireValeurs = Nothing
 
End Sub
 
Sub EssaiDicoValeurs2()
 
Dim I As Integer, J As Integer
Dim NombreDeResultats As Integer
Dim ResultatLarge() As Variant
Dim ResultatPetit() As Variant
Dim ValeurResultatLarge As String, ValeurResultatPetit As String
 
     NombreDeResultats = 3
     ReDim ResultatLarge(NombreDeResultats - 1)
     ReDim ResultatPetit(NombreDeResultats - 1)
 
     OrdonnerLesValeurs ActiveSheet, 1, 2
 
     J = 0
     For I = LBound(ListeCleValeurs) To UBound(ListeCleValeurs)
         If ListeCleValeurs(I) <> 0 Then
            ResultatPetit(J) = ListeCleValeurs(I)
            J = J + 1
         End If
         If J = NombreDeResultats Then Exit For
     Next I
 
     J = 0
     For I = UBound(ListeCleValeurs) To LBound(ListeCleValeurs) Step -1
         If ListeCleValeurs(I) <> 0 Then
            ResultatLarge(J) = ListeCleValeurs(I)
            J = J + 1
         End If
         If J = NombreDeResultats Then Exit For
     Next I
 
     ValeurResultatLarge = "Les plus grandes valeurs : " & Chr(10)
     For J = LBound(ResultatLarge) To UBound(ResultatLarge)
        ValeurResultatLarge = ValeurResultatLarge & ResultatLarge(J) & Chr(10)
     Next J
 
     ValeurResultatPetit = "Les plus petites valeurs : " & Chr(10)
     For J = LBound(ResultatPetit) To UBound(ResultatPetit)
        ValeurResultatPetit = ValeurResultatPetit & ResultatPetit(J) & Chr(10)
     Next J
 
     MsgBox ValeurResultatLarge & Chr(10) & ValeurResultatPetit
 
End Sub

Bonjour,

sans départir à l'excellente proposition d'Eric, voici comment je procède pour calculer des occurrences dans un tableau

Code:

1
2
3
4
5
6
7
8
Sub ioi()
Dim Tabl(), ValCherche As Long
ValCherche = 8 ' pour l'exemple
Tabl = Cells(1, 1).CurrentRegion.Value ' pour l'exemple ....
 
' nombre d'occurences de la valeur cherchée dans la seconde colonne
    Debug.Print UBound(Filter(Application.Transpose(Application.Index(Tabl, , 2)), ValCherche)) + 1
End Sub