XL 2013 Macro pour moyenne conditionnelle

[CHLOE90]

Bonjour le forum,
J'ai bien cherché, j'ai trouvé des choses approchantes à mon problème, mais pas spécifiquement, du coup je me décide à vous écrire.
J'aurais besoin d'une macro "évènementielle" en tous cas c'est comme ça que certains sur les forum les appelle pour traiter une moyenne conditionnelle, avec deux critères.
J'ai mis directement mes explications ainsi qu'un exemple de ce que je souhaiterais dans la feuille du fichier excel en annexe.
D'avance un grand merci à celui ou celle qui pourra s'y pencher.
Chloé.

 

[Dranreb]

Bonjour.
Code dans le module de la feuille :

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Nom, TDon(), L As Long, Somme As Double, Nbr As Long
If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub
Nom = Target.Value
TDon = [C2:E2].Resize([C1000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TDon, 1)
   If TDon(L, 1) = Nom And TDon(L, 2) = "rouge" Then
      Somme = Somme + TDon(L, 3): Nbr = Nbr + 1: End If: Next L
If Nbr = 0 Then Nbr = 1
MsgBox Nom & " :  " & "Moyenne = " & Int(10000 * Somme / Nbr + 0.5) / 100 & "%", _
   vbInformation, "Rouges"
End Sub

 

[Lone-wolf]

Bonjour CLHOE, Dranreb

Une petite modif qui prend en charge la forme au lieu du msgbox. Il fut renommer la forme "monshape" .

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Nom, TDon(), L As Long, Somme As Double, Nbr As Long, sh As Shape, result$
    If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub
    Nom = Target.Value
    TDon = [C2:E2].Resize([C1000000].End(xlUp).Row - 1).Value
    For L = 1 To UBound(TDon, 1)
        If TDon(L, 1) = Nom And TDon(L, 2) = "rouge" Then
            Somme = Somme + TDon(L, 3): Nbr = Nbr + 1: End If: Next L
    If Nbr = 0 Then Nbr = 1

    Set sh = Me.Shapes("monshape")
    result = Nom & vbLf & vbLf & "Moyenne : " & Int(10000 * Somme / Nbr + 0.5) / 100 & "%"

    sh.TextFrame.Characters.Text = result

End Sub

 

[CHLOE90]

Merci beaucoup à vous deux DRANREB et LONE-WOLF, je vais essayer de comprendre le code et mettre en pratique.
Belle journée à tous.
Chloé.