detection de valeurs VBA?

1 pièce(s) jointe(s)

Bonjour

J'ai un tableau ci dessous, dans la colonne G, il y a le nom de portefeuilles d'actions et apres il y a pour chacun leurs 5 premiere lignes actions avec un poid.

J'aimerais savoir s'il y a un outil excel pour faire une détection des 4 premieres valeurs (si on additionne leur poid)?

J'ai fais un exemple à la main dans le fichier ci joint ça sera plus simple à comprendre qu'une explication alambiquée

Ou alors il faut un code VBA?

Merci bcp :D

Garrec :ccool:

Même avec le fichier exemple, je n'ai rien compris

1 pièce(s) jointe(s)

Bonjour

C'est plus comprehensible dans ce fichier j'ai mi une ligne de commentaire.

En fait je met en couleur les actions qui sont le plus présentes dans les portefeuilles!

C'est comprehensible ou je réexplique tout :p

Merci :ccool:

Une proposition:
1. Activer la référence Microsoft Scripting Runtime

2. le résultat est récupéré sur Feuil2

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
Option Explicit
'====================================================
'/!\ Activer la référence Microsoft Scripting Runtime
'====================================================
 
Sub Test()
Const Nb As Byte = 4                               'Nb de valeurs qu'on désire récupérer
Dim LastLig As Long, i As Long, n As Long
Dim MonDico As New Scripting.Dictionary
Dim Str As String
Dim j As Integer
Dim Tb
 
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "G").End(xlUp).Row
    Tb = .Range("BF2:BO" & LastLig)
End With
 
'====On utilise un dictionnaire pour récupérer les actions sans doublon
For i = 1 To UBound(Tb, 1)
    For j = 1 To UBound(Tb, 2) - 1 Step 2
        Str = Trim(Tb(i, j))
        If Str <> "" Then
            If Not MonDico.Exists(Str) Then
                MonDico.Add Str, Tb(i, j + 1)
            Else
                MonDico(Str) = MonDico(Str) + Tb(i, j + 1)
            End If
        End If
    Next j
Next i
 
'====Le resultat trouvé est affecté à un tabkeau à 2 dimensions qu'on tri par ordre décroissant sur les poids et on récupére les Nb premières actions
n = MonDico.Count
With Worksheets("Feuil2")
    .Range("A1").CurrentRegion.ClearContents
 
    If n > 0 Then
        ReDim Tb(1 To 2, 1 To n)
        For i = 0 To n - 1
            Tb(1, i + 1) = MonDico.Keys(i)
            Tb(2, i + 1) = MonDico.items(i)
        Next i
        QuickSort Tb, 1, n
 
        ReDim Preserve Tb(1 To 2, 1 To Nb)
        .Range("A1").Resize(Nb, 2) = Application.Transpose(Tb)
    End If
End With
Set MonDico = Nothing
End Sub
 
'====Procédure de tri décroissant d'un tableau à 2 dimensions sur la 2ème dimension
 
Private Sub QuickSort(ByRef SortArray, ByVal L As Long, ByVal R As Long)
Dim i As Long, j As Long
Dim X As Double, Y
Dim k As Integer
 
i = L
j = R
X = SortArray(2, (L + R) / 2)
 
While (i <= j)
    While SortArray(2, i) > X And i < R
        i = i + 1
        DoEvents
    Wend
    While X > SortArray(2, j) And j > L
        j = j - 1
        DoEvents
    Wend
    If i <= j Then
        For k = 1 To 2
            Y = SortArray(k, i)
            SortArray(k, i) = SortArray(k, j)
            SortArray(k, j) = Y
        Next k
        i = i + 1
        j = j - 1
    End If
    DoEvents
Wend
If L < j Then Call QuickSort(SortArray, L, j)
If i < R Then Call QuickSort(SortArray, i, R)
End Sub