Discussion :

[damijoo]

Bonjour,

je désire résliaser ceci en vba mais je bloque. Dans un nouveau tableau je desires obtenir la moyenne des 3 plus grandes valeurs de la colonne 2 par classes. Ex : tableau final : moyenne top 3 des A, ligne 2, moyenne top 3 des B etc...
ci dessous un ex de données sources.


A 100
A 110
A 121
B 133,1
B 146,41
B 161,051
B 177,1561
C 194,87171
C 214,358881
C 235,7947691
C 259,374246

merci d'avance

[Theze]

Bonjour,

Pourquoi VBA ?
Ici, un classeur avec des formules matricielles :

Classeur1.xlsx

[damijoo]

merci du retour

Car je ne connais pas a l'avance ce qu'il y aura dans la colonne 1 (A,B, C est juste pour l'ex) et le nombre de lignes .

merci d'avance

[Theze]

Re,

Donc, en VBA et en inscrivant les formules en colonne D :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Test()
 
    Dim Lig As Long
    Dim Tbl
    Dim I As Integer
 
    'tableau de lettres, peut être évolutif
    Tbl = Array("A", "B", "C")
 
    'recherche la dernière ligne non vide de la colonne A de la feuille active (à adapter)
    With ActiveSheet: Lig = .Cells(.Rows.Count, 1).End(xlUp).Row: End With 'sur colonne A
 
    'inscrit les formules en colonne D (à adapter)
    For I = 0 To UBound(Tbl)
 
        Cells(I + 1, 4).FormulaArray = "=(LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Tbl(I) & """)*1,1)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Tbl(I) & """)*1,2)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Tbl(I) & """)*1,3))/3"
 
    Next I
 
End Sub

[damijoo]

Bonsoir

encore merci pour le retour

ce code me donne une visibilité. Cependant, je pense en fait que j'ai manqué de précision dans ma demande, désolé.
1.Je ne connais pas à l'avance ce qu'il y auras dans la colonne 1, j'ai mis comme exemple A,B,C mais ca peut etre des noms , des numero etc... Du coup la variable de recherche doit etre variable.
2. Le cas ou il n'a pas pas 3 occurrences dans la colonne A, ca doit etre la moyenne des 2 , ou si un seul ce que ca renvoie.

Codialement

[Theze]

Bonjour,

Avec un dictionnaire dans ce cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Test()
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim Lig As Long
    Dim I As Integer
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'défini la plage sur la colonne A de la feuille active à partir de A1
    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'dédoublonne avec un dico
    For Each Cel In Plage: Dico(Cel.Value) = Cel.Value: Next Cel
 
    Cle = Dico.Keys
    Lig = Plage.Count
 
    'inscrit les formules en colonne D (à adapter)
    For I = 0 To Dico.Count - 1
 
        Cells(I + 1, 4).FormulaArray = "=(LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,1)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,2)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,3))/3"
 
    Next I
 
End Sub

[damijoo]

ah top merci.
Par contre je n'arrive pas à corriger l'erreur d'execution sur la partie Set Dico = CreateObject("Scripting.Dictionary").
De plus, avec votre code, comment puis je ajouter les conditions
1. si occurence (ex : cells(i,1)) <2 then moyenne sur deux occurences
2. si occurence (ex : cells(i,1) unique alors renvoyer la valeur


encore merci

[Transitoire]

Bonjour,
je suis en Mac et le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Dico = CreateObject("Scripting.Dictionary")

Me renvoi aussi le message d'erreur ci-dessous


Cordialement

[Theze]

Re,

Voici le code avec prise en compte du nombre d'occurrences pour chaque clé. Si la clé en cours dans la boucle (voir le bloc "Select Case") possède trois occurrences ou plus, le diviseur sera égal à 3, si il n'y a que deux ou seulement une occurrence, le diviseur sera égal à 2 ou 1.
Si tu tournes sur Mac, les dictionnaires ne sont pas pris en charge à ma connaissance donc, il faut que je modifie le code pour me passer du dictionnaire, j'attend ton retour :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Test()
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Element As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim Lig As Long
    Dim I As Integer
    Dim Diviseur As Integer
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'défini la plage sur la colonne A de la feuille active à partir de A1
    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'dédoublonne avec un dico et mémorise le nombre d'occurrences
    For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) + 1: Next Cel
 
    Cle = Dico.Keys 'les clés du dictionnaire
    Element = Dico.Items 'les éléments du dictionnaire (le nombre d'occurrences de chaque clé)
 
    Lig = Plage.Count
 
    'inscrit les formules en colonne D (à adapter)
    For I = 0 To Dico.Count - 1
 
        'défini le diviseur
        Select Case Element(I)
 
            Case Is >= 3: Diviseur = 3 'si supérieur ou égal à 3, le diviseur est 3
            Case Else: Diviseur = Element(I) 'si égal à 2 ou 1, le diviseur sera 2 ou 1
 
        End Select
 
        Cells(I + 1, 4).FormulaArray = "=(LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,1)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,2)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,3))/" & Diviseur
 
    Next I
 
End Sub

[damijoo]

C'est top merci

j'ai juste ajouté une modif pour répondre à ma problematique. En tout cas, c'est plus smart que de coder en boules comme mon habitude


cordialement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub taille()
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Element As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim Lig As Long
    Dim I As Integer
    Dim Diviseur As Integer
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'défini la plage sur la colonne A de la feuille active à partir de A1
    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'dédoublonne avec un dico et mémorise le nombre d'occurrences
    For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) + 1: Next Cel
 
    Cle = Dico.Keys 'les clés du dictionnaire
    Element = Dico.Items 'les éléments du dictionnaire (le nombre d'occurrences de chaque clé)
 
    Lig = Plage.Count
 
    'inscrit les formules en colonne D (à adapter)
    For I = 0 To Dico.Count - 1
 
        'défini le diviseur
        Select Case Element(I)
 
            Case Is >= 3: Diviseur = 3 'si supérieur ou égal à 3, le diviseur est 3
            Case Else: Diviseur = Element(I) 'si égal à 2 ou 1, le diviseur sera 2 ou 1
 
        End Select
 
        Cells(I + 1, 4) = Cle(I)
 
        Cells(I + 1, 5).FormulaArray = "=(LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,1)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,2)+LARGE((R1C2:R" & Lig & "C2)*(R1C1:R" & Lig & "C1=""" & _
                                       Cle(I) & """)*1,3))/" & Diviseur
 
    Next I
 
End Sub