Somme prod en VBA
Bonjour le forum,
Chaque semaine, un formulaire m'incrémente le meilleur agent du mois et le meilleur agent de la semaine à date.
Je souhaite compléter le tableau actuel (cf pièce jointe) qui contient pour le moment les colonnes "date" "agent " et "motif" avec la colonne "résultat" qui va me renseigner le nombre de fois qu'un agent est désigné meilleur agent du mois dans le mois en cours.
Il me faut donc un complément de code vba...
J'ai suivi la piste evaluate(sumproduct) sans succès...
Une idée?
Merci par avance!
Pour de plus amples informations,
Vous trouverez ci dessous le code à compléter. Il me reste finalement le résultat de cette ligne.Worksheets("ENTRETIENS").Cells(derligne, 6) = ????
Private Sub MEILLEUR_MOIS()
Dim NumMois As String, NumAn As String
Dim N As Integer
Dim Dico, k, i
Dim C As Range
Dim MaxA As String
Dim MaxR As Double
On Error Resume Next
With Worksheets("ENTRETIENS")
If Range("D11") = "" Then derligne = 11 Else derligne = Range("D" & Rows.Count).End(xlUp).Row + 1
Set Dico = CreateObject("Scripting.dictionary")
NumAn = Year(Date)
NumMois = Month(Date)
With ThisWorkbook.Worksheets("PERFORMANCE TELEPROSPECTEURS")
Worksheets("MENU").Cells(7, 3) = ""
For Each C In .Range("D11:D" & .Range("D" & Rows.Count).End(xlUp).Row)
If Month(C.Offset(0, -1).Value) = NumMois And Year(C.Offset(0, -1).Value) = NumAn Then
If Not Dico.Exists(C.Value) Then
Dico.Add C.Value, C.Offset(0, 8).Value
Else
Dico.Item(C.Value) = Dico.Item(C.Value) + C.Offset(0, 8).Value
End If
End If
If MaxR < Dico.Item(C.Value) Then
MaxA = C.Value
MaxR = Dico.Item(C.Value)
End If
Next C
If MaxA <> "" Then
Worksheets("ENTRETIENS").Cells(derligne, 3) = Date + 3
Worksheets("ENTRETIENS").Cells(derligne, 4) = MaxA
Worksheets("ENTRETIENS").Cells(derligne, 5) = Worksheets("MENU").Range("C6")
Worksheets("ENTRETIENS").Cells(derligne, 6) = MaxR & " R1" & " pris ce mois ci."
Worksheets("ENTRETIENS").Cells(derligne, 7) =
End If
End With
End With
derligne = derligne + 1
End SubCordialement
Bonjour le forum,
J'ai vu sur internet qu'on a la possibilité d'utiliser For each à la place d'une sommeprod avec deux arguments à croiser:
Dim c As Range
For Each c In Range('D1:D10')
If c.Value = "MEILLEUR AGENT DU MOIS" Then
End If
Next c
Cette méthode peut peut être marcher?
Cordialement
Bonjour
Le problème c'est que entre ce que tu dis et le fichier beaucoup de différences
Relien33 a écrit :Il me faut donc un complément de code vba...
Le fichier joint ne comporte aucun code !!!!!!
Ensuite dans le code tu as les pages "ENTRETIENS", "PERFORMANCE TELEPROSPECTEURS" et "MENU"
Elles sont où dans le fichier ?
J'ai trouvé une formule (assez compliqué pour moi) Surement plus simple, mais cela dépasse mes compétences
Testes la et dis ce qui ne va pas
Bonjour Banzai64
Pour être plus clair. Vous trouverez ci-joint une adaptation de ce que je veux. En gros, si on click sur le bouton de commande je veux qu'il y ait écrit "1ère fois" dans la case résultat puisque dans le tableau, c'est la première fois que l'agent 1 est déclaré meilleur agent du mois ce mois ci. Si on click de nouveau sur le bouton et que l'agent est encore "agent1"je veux qu'il y ait écrit "2eme fois" etc etc. Bien sûr, si le nom de l'agent de la deuxième ligne est "agent 2" la valeur de la colonne résultat sera '1ère fois". Je souhaite trouver un moyen sans utiliser de colonne intermédiaire pour arriver a mes fins. Dans mon programme de référence il y aura différentes valeurs dans la colonne motif d'où la formule qui suit.
La condition est donc:
Si(SOMMEPROD((MOIS(Tableau1[DATE])=MOIS(AUJOURDHUI()))*(Tableau1[AGENT]=Tableau1[@AGENT])*(Tableau1[MOTIF]="MEILLEUR DU MOIS")))=1 alors "1ère fois"
Si(SOMMEPROD((MOIS(Tableau1[DATE])=MOIS(AUJOURDHUI()))*(Tableau1[AGENT]=Tableau1[@AGENT])*(Tableau1[MOTIF]="MEILLEUR DU MOIS")))=2 alors "2ère fois"
...
Je ne peux pas utiliser ces formules sur le tableau car les valeurs changeront à chaque changement de mois c'est pourquoi je cherche une alternative VBA.
Les informations sont elles plus claires?
Merci par avance
Bonjour
Tu n'as pas dit si le résultat proposé est exact
Et il n'y a pas de colonne intermédiaire
Rebonjour;
Il n'y a effectivement pas de colonne intermédiaire dans votre proposition. Je précisais simplement cette information pour les autres membres. La solution proposée est intéressante seulement je suis à la recherche d'un code VBA que je pourrai faire évoluer. Le tableau sera utilisé par plusieurs personnes donc j'ai peur que les formules sautent. S'il n'y a effectivement aucun moyen votre solution sera parfaite.
Cordialement
Bonsoir le forum,
Afin de savoir s'il existe une alternative en VBA quelqu'un peut il me dire si le problème que je rencontre peut trouver une solution où s'il faut que me penche sur un autre méthode?
Cdt
Bonsoir,
Je suis une piste avec le code précédemment évoqué. Je tente d'utiliser de nouveau Evaluate seulement je coince à un endroit
Il semblerait que MaxA dans la ligne
Evaluate("= SumProduct((MONTH(C11:C" & derligne & ")=" & NumMois & ")*(D11:D" & derligne & "=" & MaxA & ") * (E11:E" & derligne & "=""PREMIER DU MOIS""))")ne soit pas reconnu...
Private Sub MEILLEUR_MOIS()
Dim NumMois As String, NumAn As String
Dim N As Integer
Dim Dico, k, i
Dim C As Range
Dim MaxA As String
Dim MaxR As Double
On Error Resume Next
With Worksheets("ENTRETIENS")
If Range("D11") = "" Then derligne = 11 Else derligne = Range("D" & Rows.Count).End(xlUp).Row + 1
Set Dico = CreateObject("Scripting.dictionary")
NumAn = Year(Date)
NumMois = Month(Date)
With ThisWorkbook.Worksheets("PERFORMANCE TELEPROSPECTEURS")
Worksheets("MENU").Cells(7, 3) = ""
For Each C In .Range("D11:D" & .Range("D" & Rows.Count).End(xlUp).Row)
If Month(C.Offset(0, -1).Value) = NumMois And Year(C.Offset(0, -1).Value) = NumAn Then
If Not Dico.Exists(C.Value) Then
Dico.Add C.Value, C.Offset(0, 8).Value
Else
Dico.Item(C.Value) = Dico.Item(C.Value) + C.Offset(0, 8).Value
End If
End If
If MaxR < Dico.Item(C.Value) Then
MaxA = C.Value
MaxR = Dico.Item(C.Value)
End If
Next C
If MaxA <> "" Then
Worksheets("ENTRETIENS").Cells(derligne, 3) = Date + 3
Worksheets("ENTRETIENS").Cells(derligne, 4) = MaxA
Worksheets("ENTRETIENS").Cells(derligne, 5) = Worksheets("MENU").Range("C6")
Worksheets("ENTRETIENS").Cells(derligne, 6) = MaxR & " R1" & " pris ce mois ci."
Worksheets("ENTRETIENS").Cells(derligne, 7) = Evaluate("= SumProduct((MONTH(C11:C" & derligne & ")=" & NumMois & ")*(D11:D" & derligne & "=" & MaxA & ") * (E11:E" & derligne & "=""PREMIER DU MOIS""))")
End If
End With
End With
derligne = derligne + 1
End SubQuelqu'un sait-il d'où ca peut venir?
Bonne soirée
Bonjour,
Je viens de trouver la solution:
If Evaluate("= SumProduct((MONTH(C11:C" & pag & ")=" & NumMois & ")*(D11:D" & pag & "=" & .Cells(pag, 4).Address & ") * (E11:E" & pag & "=""MEILLEUR DU MOIS""))") = 1 Then
Sheets("ENTRETIENS").Range("G" & pag) = "1ERE FOIS"
End If
If Evaluate("= SumProduct((MONTH(C11:C" & pag & ")=" & NumMois & ")*(D11:D" & pag & "=" & .Cells(pag, 4).Address & ") * (E11:E" & pag & "=""MEILLEUR DU MOIS""))") = 2 Then
Sheets("ENTRETIENS").Range("G" & pag) = "2EME FOIS"
End If
If Evaluate("= SumProduct((MONTH(C11:C" & pag & ")=" & NumMois & ")*(D11:D" & pag & "=" & .Cells(pag, 4).Address & ") * (E11:E" & pag & "=""MEILLEUR DU MOIS""))") = 3 Then
Sheets("ENTRETIENS").Range("G" & pag) = "3EME FOIS"
End IfCdt