Macro Moyenne Si

Option Explicit
Sub TopActeursNombreEtMoyenne()
'
Dim v As Variant      'tableau des valeurs de cellules
Dim t As Variant      'tableau temporaire
Dim q As Object       'quantité
Dim m As Object       'moyenne
Dim a As String       'artiste
Dim n As Double       'note
Dim d As Long         'derniète ligne
Dim i As Long         'index
Dim j As Long         'index
  With Worksheets("Base")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
    v = .Range("B3:D" & d).Value
  End With
  Set q = CreateObject("Scripting.Dictionary")
  Set m = CreateObject("Scripting.Dictionary")
  ' Compter les artistes et totaliser les notes
  For i = LBound(v) To UBound(v)
     t = Split(v(i, 3), ",")
     For j = LBound(t) To UBound(t)
       a = Trim(Replace(t(j), Chr(160), " "))
       If a <> "" Then
         q(a) = q(a) + 1
         n = v(i, 1)
         m(a) = m(a) + n
       End If
     Next j
  Next i
  Erase v
  With Worksheets("Top Acteurs")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
    ' Effacer les quantités et moyennes précédentes
    .Range("B3:C" & d).ClearContents
    ' Mettre à jour les résultats : quantité et moyenne
    v = .Range("A3:C" & d).Value
    For i = LBound(v) To UBound(v)
      a = Trim(Replace(v(i, 1), Chr(160), " "))
      If q.Exists(a) Then
        v(i, 2) = q(a)
        n = m(a) / q(a)
        v(i, 3) = n
      Else
        v(i, 2) = "Non trouvé"
        v(i, 3) = ""
      End If
    Next i
    .Range("A3:C" & d).Value = v
  End With
End Sub

' Inutile de copier le code essayé
'

Sub TopActeursNombre()
'
' TopActeursNombre Macro
'
Dim f As String
Dim d As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  f = "=IFERROR(COUNTIF(Base!R3C4:R@C4,""*"" & RC1 & ""*""),RC1 & "" non trouvé"")"
  With Worksheets("Base")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
  End With
  f = Replace(f, "@", d)
  With Worksheets("Top Acteurs")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("B3:B" & d).FormulaR1C1 = f
    .Calculate
    .Range("B3:B" & d).Value = .Range("B3:B" & d).Value
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Option Explicit
Sub TopActeursMoyenne()
'
' TopActeursMoyenne Macro
'
Dim f As String
Dim d As Long
  f = "=AVERAGEIF(Base!R3C1:R@C1,RC1,Base!R3C2:R@C2)"
  With Worksheets("Base")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
  End With
  f = Replace(f, "@", d)
   With Worksheets("Top Acteurs")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("C3:C" & d).FormulaR1C1 = f
  End With
End Sub