Macro Moyenne Si Résolu

Question

Bonjour,

J'essaie de faire une macro avec l'opération moyenne si dont le critère est le contenu d'une cellule. 

Mais comme je débute, ça ne marche pas... 

Voici ma Macro : 

Sub TopActeursMoyenne()
'
' TopActeursMoyenne Macro
'

'
    Sheets("Top Acteurs").Select
    ActiveCell.FormulaR1C1 = _
        "=AVERAGEIF(Base!C,""*""&'Top Acteurs'!RC[-2]&""*"",Base!C[-1])"
    Range("C3").Select
    Selection.AutoFill Destination:=Range("C3:C6536")

End Sub

Lorsque j'active la macro, l'opération se fait une seule fois et pas du tout au bon endroit.
Est-ce que quelqu'un peut m'aider ?

Merci beaucoup !!!!!!

Patrice33740 · Answer

Bonjour,

« Est-ce que quelqu'un peut m'aider ? » Oui, mais il faut que tu prennes l'habitude de décrire ce que tu voudrais exactement. Quand il faut qu'on devinne c'est généralement du temps perdu.

Où se trouvent les données ? nom de la feuille et adresse de la cellule ou de la plage de cellules
Où veux mettre ta formule ? nom de la feuille et adresse de la cellule ou de la plage de cellules

Patrice33740 · Answer

Re,

Essaies :
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

Patrice33740 · Answer

Re,

1) « Ca fait sacrément mouliner mon ordinateur » c'est pour cela que j'ai remplacé les formules par leur valeur (ligne 19), sinon ça ramerait tout le temps.

2) Je ne réponds pas aux MP (messages personnels) lorsqu'il peuvent servir à d'autres. Autant continuer le fil. 
Je reproduis  ta question : 
Merci beaucoup de m'avoir aidé pour ma macro Moyenne Si !!!
J'ai essayé de le modifier pour faire un NB.SI et avoir le résultat dans ma colonne B.
J'ai essayé :
' Inutile de copier le code essayé
'
Mais cela ne fonctionne pas. 

Essaies ce code :
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
 --
Cordialement
Patrice

Patrice33740 · Answer

Re,

Voilà les 2 calculs en  beaucoup plus rapide :
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

Patrice33740 · Answer

Bonjour,

Voici une approche similaire qui efface et recrée la liste des artistes :
https://mon-partage.fr/f/NW8xf2nN/ 

Cela présente trois avantages :
1 - N'oublier aucun artiste
2 - Éliminer de la liste les artiste absents de la base de données
3 - Détecter visuellement certaines erreurs d'orthographe dans la base (par exemple André Dussollier)

Macro Moyenne Si

5 réponses

Discussions similaires

Newsletters