Menu

Macro Moyenne Si [Résolu]

Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
- - Dernière réponse : Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
- 4 janv. 2019 à 15:45
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 !!!!!!
Afficher la suite 

Votre réponse

5 réponses

Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622
0
Merci
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


Cordialement
Patrice
Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Patrice, désolé de ce manque d'informations.

Voici les détails de la formule Moyenne Si que je voudrais mettre en place dans la macro :

Plage : Feuille Base / Colonne D (de D3 à D3544 actuellement mais ajout de données quotidiennes)

Critères : Feuille Top Acteurs / Contenu des cellules de la Colonne A (de A3 à A6536 actuellement mais ajout de donnée quotidiennes)

Plage de la Moyenne : Feuille Base / Colonne B (de B3 à B3544 actuellement mais ajout de données quotidiennes)


Merci !!!
Commenter la réponse de Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622
0
Merci
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



Cordialement
Patrice
Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Merci beaucoup pour la proposition.
Malheureusement, cela ne fonctionne pas.

Sur ma feuille Top Acteurs, j'obtiens que des #DIV/0!.
J'ai l'impression que le problème vient du fait que la matrice génère des A en critère de ma Moyenne Si, et pas des "*"&A&"*".

Comment je peux faire pour corriger cela ?

Merci !!!!!!!!
Bien à vous.
Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622 -
Re,

Les #DIV/0 ne sont pas un signe de dysfonctionnement !
Il signifient seulement que la valeur cherchée n'a pas été trouvée.
On peut les éliminer avec SIERREUR :
Option Explicit
Sub TopActeursMoyenne()
'
' TopActeursMoyenne Macro
'
Dim f As String
Dim d As Long
  f = "=IFERROR(AVERAGEIF(Base!R3C1:R@C1,RC1,Base!R3C2:R@C2),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("C3:C" & d).FormulaR1C1 = f
  End With
End Sub


Exemple :
https://mon-partage.fr/f/OVxklikk/
Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Merci beaucoup de consacrer du temps à mon problème!
Sauf que tout mon excel renvoie un #DIV/0. Il n'y aurait aucune occurence (alors que je sais qu'il y en a).
Selon moi, cela vient du fait qu'à la différence de votre exemple, mon excel se présente comme ceci :

Feuille Base
Jean Nicolas, Paul Adrien, Marcel Cerdan, Maurice Pialat

Feuille Top Acteurs
Jean Nicolas
Paul Adrien
Marcel Cerdan
Maurice Pialat


Je vous joins l'excel car je n'arrive pas à expliquer correctement :
https://we.tl/t-6VrbdsDNwH

Encore merci Patrice !
Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622 -
Re,

Option Explicit
Sub TopActeursMoyenne()
'
' TopActeursMoyenne Macro
'
Dim f As String
Dim d As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  f = "=IFERROR(AVERAGEIF(Base!R3C4:R@C4,""*"" & RC1 & ""*"",Base!R3C2:R@C2),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("C3:C" & d).FormulaR1C1 = f
    .Calculate
    .Range("C3:C" & d).Value = .Range("C3:C" & d).Value
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Merci beaucoup !!!!!!!!!!!!!!!!!!
Ca fait sacrément mouliner mon ordinateur, mais cela marche parfaitement !!!

Encore merci !!!!
Cdt.
Commenter la réponse de Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622
0
Merci
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
Commenter la réponse de Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622
0
Merci
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


Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Patrice, merci énormément !!!
Cela fait les deux calculs en même, et de manière très rapide !

Merci beaucoup !!
Bien à vous.
Commenter la réponse de Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622
0
Merci
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)
Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
Merci beaucoup Patrice !!! C'est parfait !
Bien à vous.
Patrice33740
Messages postés
7539
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
23 janvier 2019
1622 > Christouf1542
Messages postés
12
Date d'inscription
mercredi 2 janvier 2019
Dernière intervention
4 janvier 2019
-
De rien, au plaisir de te relire sur le Forum

Cordialement
Patrice
Commenter la réponse de Patrice33740