VBA - average sous conditions

Version imprimable

30/07/2018, 19h10
damijoo

VBA - average sous conditions

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
30/07/2018, 20h02
Theze

1 pièce(s) jointe(s)

Bonjour,

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

Pièce jointe 400395
30/07/2018, 20h06
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

Re,

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

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
 
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

30/07/2018, 21h29
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

Bonjour,

Avec un dictionnaire dans ce cas :

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
 
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

31/07/2018, 10h04
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
31/07/2018, 16h24
Transitoire

1 pièce(s) jointe(s)

Bonjour,
je suis en Mac et le code:

Code:

Set Dico = CreateObject("Scripting.Dictionary")

Me renvoi aussi le message d'erreur ci-dessous
Pièce jointe 400626

Cordialement 8-)

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:

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

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:

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