Récupérer le code source de la fonction LARGE vba

Version imprimable

Bonjour,

J'ai un tableau (Tableau) contenant des numéros (i) et des montants devant chacun de ces numéros (j).
J'ai ainsi : Tableau(i)=j

L'idée est de récupérer les numéros qui sont associés aux k-ièmes plus grandes valeurs.

Pour récupérer le montant, je n'aurais eu qu'à faire :

Code:

Application.WorksheetFunction.Large(Tableau,k)

Cependant, je veux ici récupérer non j, mais i (il peut en plus y avoir plusieurs i...)
Il me faudrait ainsi modifier légèrement le code initial de la fonction Large. Et pour cela, j'aurais besoin du code initial de la fonction Large.

Quelqu'un saurait-il m'aider ? (une autre idée serait également bienvenue!)

Pour l'instant, j'ai testé ceci (mais ça ne marche pas vraiment...)
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 Public Tableau(5) As Integer Public TableauTempo(5) As Integer Public TableauN°Max(5) As Integer Public Succès As Boolean Public k As Integer Sub récupérerN°MaxAdapté() Tableau(1) = 1 Tableau(2) = 10 Tableau(3) = 5 Tableau(4) = 4 Tableau(5) = 10 For i = 1 To 5 TableauTempo(i) = Tableau(i) Next i 'on récupère d'abord le Max le plus grand, puis le second... k = 0 Do 'On récupère le plus grand Max parmi ceux non encore testés (stockés dans le Tableau "TableauSecond" Call récupérerN°Max 'On le teste Call condition(k) 'On explique que celui-ci a été testé For N° = k To 4 TableauTempo(N°) = Tableau(N° + 1) Next N° k = k + 1 'si le test est un succès, plus besoin de passer au suivant Loop While Succès <> True For i = 1 To k MsgBox TableauN°Max(i) Next i End Sub Sub récupérerN°Max() 'on récupère le Max For N° = 1 To 5 If TableauTempo(N°) > Max Then Max = TableauTempo(N°) End If Next N° 'On récupère tous les numéros qui sont associés à ce Max For N° = 1 To 5 If TableauTempo(N°) = Max Then j = j + 1 TableauN°Max(j) = N° End If Next N° End Sub Function condition(k) If Rnd > 0.75 Then Succès = True End If End Function
Merci !

Bonjour,

Si j'ai bien compris, tu veux récupérer les x plus grandes valeurs d'un tableau avec l'indice de position dans le tableau de ces valeurs ?
Une piste ci-dessous mais attention, ici, les valeurs identiques ne sont pas retournées. Je pense qu'en bidouillant encore un peu le code il est possible de le faire. Si j'ai le temps, je m'y pencherai encore un peu dessus mais bon c'est une piste de départ parmi d'autres :

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
Sub test()
 
    Dim Tbl(1 To 10) As Double
    Dim TblRetour() As Double
    Dim I As Integer
 
    Tbl(1) = 1
    Tbl(2) = 10
    Tbl(3) = 5
    Tbl(4) = 25
    Tbl(5) = 10
    Tbl(6) = 1
    Tbl(7) = 36
    Tbl(8) = 5
    Tbl(9) = 25
    Tbl(10) = 10
 
    TblRetour = Max(Tbl(), 4)
 
    For I = 1 To UBound(TblRetour, 2)
 
        Debug.Print TblRetour(1, I)
        Debug.Print TblRetour(2, I)
 
    Next I
 
End Sub
 
Function Max(Tablo() As Double, Nb As Integer) As Double()
 
    Dim Tbl() As Double
    Dim I As Integer
    Dim J As Integer
 
    For I = 1 To Nb
 
        ReDim Preserve Tbl(1 To 2, 1 To I)
 
        If I = 1 Then
 
            For J = 1 To UBound(Tablo)
 
                If Tablo(J) > Tbl(1, I) Then
 
                    Tbl(1, I) = Tablo(J)
                    Tbl(2, I) = J
 
                End If
 
            Next J
 
        Else
 
            For J = 1 To UBound(Tablo)
 
                If Tablo(J) > Tbl(1, I) And Tablo(J) < Tbl(1, I - 1) Then
 
                    Tbl(1, I) = Tablo(J)
                    Tbl(2, I) = J
 
                End If
 
            Next J
 
        End If
 
    Next I
 
    Max = Tbl()
 
End Function

Hervé.

Bonjour,

Pour compléter ma réponse.
Comme la fonction "Large" est sans doute une fonction de tri qui retourne ensuite les x plus grandes valeurs, je suis donc parti d'une fonction de tri pour retourner les x plus grandes valeurs (ou plus petites valeurs selon le signe < ou >) en utilisant un tableau intermédiaire pour pouvoir retourner aussi les index de position :

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
Sub test()
 
    Dim Tbl(1 To 10) As Double
    Dim TblRetour() As Double
    Dim I As Integer
 
    Tbl(1) = 1
    Tbl(2) = 10
    Tbl(3) = 5
    Tbl(4) = 25
    Tbl(5) = 10
    Tbl(6) = 1
    Tbl(7) = 36
    Tbl(8) = 5
    Tbl(9) = 25
    Tbl(10) = 10
 
    TblRetour = Max(Tbl(), 4)
 
    For I = 1 To UBound(TblRetour, 2)
 
        Debug.Print "Valeur : " & TblRetour(1, I) & " Index : " & TblRetour(2, I)
 
    Next I
 
End Sub
 
Function Max(Tablo() As Double, Nb As Integer) As Double()
 
    Dim Tbl() As Double
    Dim Valeur As Double
    Dim Index As Long
    Dim I As Long
    Dim J As Long
 
    'crée un tableau à 2 dimensions pour stocker les index
    ReDim Tbl(1 To 2, 1 To UBound(Tablo))
 
    'tranfère les valeurs et mémorise les index
    For I = 1 To UBound(Tablo)
 
        Tbl(1, I) = Tablo(I)
        Tbl(2, I) = I
 
    Next I
 
    '"<" pour les plus grandes valeur  et ">" pour les plus petites valeurs
    For I = 1 To UBound(Tbl, 2) - 1
 
        For J = I + 1 To UBound(Tbl, 2)
 
            If Tbl(1, I) < Tbl(1, J) Then
 
                Valeur = Tbl(1, J)
                Index = Tbl(2, J)
                Tbl(1, J) = Tbl(1, I)
                Tbl(2, J) = Tbl(2, I)
                Tbl(1, I) = Valeur
                Tbl(2, I) = Index
 
            End If
 
        Next J
 
    Next I
 
    ReDim Preserve Tbl(1 To 2, 1 To Nb)
 
    Max = Tbl
 
End Function

Hervé.

Petite précision, les valeurs égales sont retournées, ce qui n'est pas le cas dans ma première proposition.

Hervé.

16/03/2014, 14h20
Novice_vba

Bonjour,

Merci, votre code marche bien pour classer les valeurs du tableau. Pour autant, ce n'est pas complètement ce que j'essayais de faire. Votre code semble presque faire "plus" que ce que je cherchais à faire au début, mais je n'arrive pas à l'adapter pour obtenir la réponse ci-dessous:

Je tentais de réaliser une fonction qui aurait pour argument un tableau (Tableau), et un classement (Classement), et qui me retournerait tous les numéros d'index associés.
Par exemple, avec les chiffres de votre tableau, si on souhaite les deuxième plus grandes valeurs (Classement=2) du Tableau, on obtiendrait 9 et 4 (correspondant aux numéros d'index associés).

Voilà pourquoi dans mon programme initial, j'ai d'abord tenté de récupérer la valeur du n-ième max (1ère boucle), puis ai cherché à récupérer les indexs correspondants à cette valeur (seconde boucle), afin de les stocker dans un tableau.

Novice_vba

Bonsoir,

De cette façon peut être ?

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
 
Sub test()
 
    Dim Tbl(1 To 10) As Double
    Dim TblRetour() As Double
    Dim I As Integer
 
    Tbl(1) = 1
    Tbl(2) = 10
    Tbl(3) = 5
    Tbl(4) = 25
    Tbl(5) = 10
    Tbl(6) = 1
    Tbl(7) = 36
    Tbl(8) = 5
    Tbl(9) = 25
    Tbl(10) = 10
 
    TblRetour = Max(Tbl(), 2)
 
    For I = 1 To UBound(TblRetour, 2)
 
        Debug.Print "Valeur : " & TblRetour(1, I) & " Index : " & TblRetour(2, I)
 
    Next I
 
End Sub
 
Function Max(Tablo() As Double, Nb As Integer) As Double()
 
    Dim Tbl() As Double
    Dim TblRetour() As Double
    Dim Valeur As Double
    Dim Index As Long
    Dim I As Long
    Dim J As Long
 
    'crée un tableau à 2 dimensions pour stocker les index
    ReDim Tbl(1 To 2, 1 To UBound(Tablo))
 
    'tranfère les valeurs et mémorise les index
    For I = 1 To UBound(Tablo)
 
        Tbl(1, I) = Tablo(I)
        Tbl(2, I) = I
 
    Next I
 
    '"<" pour les plus grandes valeur  et ">" pour les plus petites valeurs
    For I = 1 To UBound(Tbl, 2) - 1
 
        For J = I + 1 To UBound(Tbl, 2)
 
            If Tbl(1, I) < Tbl(1, J) Then
 
                Valeur = Tbl(1, J)
                Index = Tbl(2, J)
                Tbl(1, J) = Tbl(1, I)
                Tbl(2, J) = Tbl(2, I)
                Tbl(1, I) = Valeur
                Tbl(2, I) = Index
 
            End If
 
        Next J
 
    Next I
 
    J = 0
 
    'récupère la valeur de référence
    Valeur = Tbl(1, Nb)
 
    'boucle pour toutes les trouver et les stocke dans un autre tableau intermédiaire
    For I = 1 To UBound(Tbl, 2)
 
        If Tbl(1, I) = Valeur Then
 
            J = J + 1
 
            ReDim Preserve TblRetour(1 To 2, 1 To J)
            TblRetour(1, J) = Tbl(1, I)
            TblRetour(2, J) = Tbl(2, I)
 
        End If
 
    Next I
 
    Max = TblRetour
 
End Function

Hervé.

17/03/2014, 11h49
Novice_vba

Bonjour,

Cela marche parfaitement, et le code est parfaitement compréhensible (même si utiliser un tableau intermédiaire pour stocker à la fois l'index et les valeurs ne me serait pas venu naturellement à l'esprit),

Merci !