VBA Fonction Small

Version imprimable

VBA Fonction Small

Bonjour,

J'ai défini des variables et je souhaite prendre la 2 ème plus petite valeurs de ces dernières.
Je n'arrive pas à adapter la fonction Small dans mon code VBA.

J'ai indiqué en rouge la function que je veux adapter.

Si quelqu'un a une solution...

Merci beaucoup!

Kesdo

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
Dim SPRatings As Variant, FitchRatings As Variant, DBRSRatings As Variant, MoodysRatings As Variant, ERRatings As Variant, Ratings As Variant

    SPRatings = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", "BBB", "BBB-", "BB+", "BB", "BB-", "B+", "B", "B-", "CCC+", "CCC", "CCC-", "NR")
    FitchRatings = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", "BBB", "BBB-", "BB+", "BB", "BB-", "B+", "B", "B-", "CCC+", "CCC", "CCC-", "NR")
    DBRSRatings = Array("AAA", "AA(High)", "AA", "AA(Low)", "A(High)", "A", "A(Low)", "BBB(High)", "BBB", "BBB(Low)", "BB(High)", "BB", "BB(Low)", "B(High)", "B", "B(Low)", "CCC(High)", "CCC", "CCC(Low)", "NR")
    MoodysRatings = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3", "Baa1", "Baa2", "Baa3", "Ba1", "Ba2", "Ba3", "B1", "B2", "B3", "Caa1", "Caa2", "Caa3", "NR")
   
    Ratings = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "0")
    
    ub = UBound(Ratings)
    lb = LBound(Ratings)


    For j = lb To ub
         If ERRating = CStr(MoodysRatings(j)) Then
         ERRating = Ratings(j)
         End If
         If MoodysRating = CStr(MoodysRatings(j)) Then
         MoodysRating = Ratings(j)
         End If
         If FitchRating = CStr(FitchRatings(j)) Then
         FitchRating = Ratings(j)
         End If
         If DBRSRating = CStr(DBRSRatings(j)) Then
         DBRSRating = Ratings(j)
         End If
         If SPRating = CStr(SPRatings(j)) Then
         SPRating = Ratings(j)
         End If
    Next j

RetainRating = WorksheetFunction.Small({ERRating, MoodysRating, FitchRating, DBRSRating, SPRating};2)

01/07/2013, 10h54
EngueEngue

Tu as 4 tableaux, de 20 strings.

Si tu veux avoir le deuxième plus bas rating, il suffit de boucler sur les 4 tableaux, trouver les indices en comparant les données pour chacun d'entre eux et les stocker dans un tableau de 4 entiers, trier le tableau par ordre croissant et prendre la ième valeur.

2 dans ton cas.

Un jeu d'enfant.

Bonjour,

Le premier paramètre à passer à la fonction Small est un seul et unique tableau (du moins, je crois).
Essayez de réunir tous vos tableaux en un seul comme dans l'exemple ci-dessous

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
Dim T()
Dim cpt&  'compteur
For j = lb To ub
  If ERRating = CStr(MoodysRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If MoodysRating = CStr(MoodysRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If FitchRating = CStr(FitchRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If DBRSRating = CStr(DBRSRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If SPRating = CStr(SPRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
Next j
 
RetainRating = Application.WorksheetFunction.Small(T, 2)

Est-ce mieux ?

01/07/2013, 11h16
EngueEngue

Je pense que le pb vient surtout du fait qu'il a mis un point virgule au lieu d'une virgule...

Code:

RetainRating = WorksheetFunction.Small(Array(ERRating, MoodysRating, FitchRating, DBRSRating, SPRating),2)

Bonjour,

Merci à vous deux, je suis en train d'essayer d'adapter vos suggestions..

Je vous reviens!

La fonction me ressort toujours en #VALUE ::(

Je vous met l'intégralité de la fonction ci-dessous.

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
 
 
Function RetainRating(ERRating As String, MoodysRating As String, FitchRating As String, DBRSRating As String, SPRating As String) As String
'Returns the retain rating
 
 
'Formating ERrating notation
If Left(ERRating, 1) = "i" Then
EIFRating = Right(ERRating, Len(ERRating) - 1)
End If
 
'Converting from Fitch SP ER DBRS Moody's Rating to scale
Dim i As Integer, j As Integer, UB As Integer, LB As Integer, test As Integer
 
Dim SPRatings As Variant, FitchRatings As Variant, DBRSRatings As Variant, MoodysRatings As Variant, ERRatings As Variant, Ratings As Variant
 
    SPRatings = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", "BBB", "BBB-", "BB+", "BB", "BB-", "B+", "B", "B-", "CCC+", "CCC", "CCC-", "NR")
    FitchRatings = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", "BBB", "BBB-", "BB+", "BB", "BB-", "B+", "B", "B-", "CCC+", "CCC", "CCC-", "NR")
    DBRSRatings = Array("AAA", "AA(High)", "AA", "AA(Low)", "A(High)", "A", "A(Low)", "BBB(High)", "BBB", "BBB(Low)", "BB(High)", "BB", "BB(Low)", "B(High)", "B", "B(Low)", "CCC(High)", "CCC", "CCC(Low)", "NR")
    MoodysRatings = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3", "Baa1", "Baa2", "Baa3", "Ba1", "Ba2", "Ba3", "B1", "B2", "B3", "Caa1", "Caa2", "Caa3", "NR")
 
    Ratings = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "0")
 
    UB = UBound(Ratings)
    LB = LBound(Ratings)
 
Dim T()
 
Dim cpt&  'compteur
 
For j = LB To UB
  If ERRating = CStr(MoodysRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If MoodysRating = CStr(MoodysRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If FitchRating = CStr(FitchRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If DBRSRating = CStr(DBRSRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
  If SPRating = CStr(SPRatings(j)) Then
    cpt = cpt + 1
    ReDim Preserve T(1 To cpt)
    T(cpt) = Ratings(j)
  End If
Next j
 
RetainRating = Application.WorksheetFunction.Small(T, 2)
 
   For j = LB To UB
         If RetainRating = CStr(Ratings(j)) Then
         RetainRating = MoodysRatings(j)
         End If
   Next j
 
End Function

01/07/2013, 12h30
EngueEngue

Citation:

Envoyé par EngueEngue

Je pense que le pb vient surtout du fait qu'il a mis un point virgule au lieu d'une virgule...

Code:

RetainRating = WorksheetFunction.Small(Array(ERRating, MoodysRating, FitchRating, DBRSRating, SPRating),2)

Code:

Ratings = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "0")

Pourquoi mettre des guillemets ? Ce sont des indices et non des strings. (Le dernier devrait être 20 et non zéro)

Avec ces modifs ça marche chez moi.
01/07/2013, 14h22
kesdo

Merci beaucoup pour ton aide!
01/07/2013, 14h24
EngueEngue

Je n'ai rien fait.. tu avais déjà tout fait! (même si j'aurais fait autrement :p)