Diviser par le nombre d'occurence

Version imprimable

11/03/2019, 21h56
aba2s

1 pièce(s) jointe(s)

Diviser par le nombre d'occurence

Bonjour la communauté,
Je me tourne vers vous car je galère depuis quelques jours sur une de mes macros.
Je souhaite qu'a chaque valeur trouvée que la macro fait une comparaison. Au final on devrait pour l'insertion Orders
"2019-02 - Television - CRV Hybrid - Mob. + tab. - Vid. pre-roll - VTR" et Vendor Name "DBM" on devrait avoir 15 occurence. Ce qui fait qu'on obtiendrait 1333,33.
Les valeurs que j'ai en colonne D c'est ce que je voudrai avoir.

Merci pour votre aide
12/03/2019, 03h24
Invité

Citation:

Envoyé par aba2s

Bonjour,

Pourquoi utiliser une macro ?
Pièce jointe 456969
12/03/2019, 08h39
aba2s

1 pièce(s) jointe(s)

Diviser par le nombre d'occurence

Bonjour Eric,
Merci beaucoup d'avoir répondu. Elle est très impressionnante ta fonction SommeProd. Je ne l'avias jamais utilisé :)
Elle aurait tout résolu mais malheureusement dans le cadre de ce projet une macro serait l'ideale. La macro est appelé dans d'autres marcos.
Si nous utilisons une fonction, à chaque nouvelle fichier que nous importons la formule sera perdue.
Mais je suis très content d'avoir appris l'utilisation de la fonction SommeProd.

Je remets ici le fichier car dans l'ancien il y avait deux doublons dans la feuille Info.

Merci beaucoup

Citation:

Envoyé par aba2s

Si nous utilisons une fonction, à chaque nouvelle fichier que nous importons la formule sera perdue.

En utilisant l'enregistreur de macro, rentrez dans les cellules K2 et L2, faites entrer et terminez la macro.
En adaptant et généralisant le code récupéré, vous pourriez reconstituer votre tableau avec ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub MettreEnPlaceLesFormules() Dim DerniereLigne As Long With Sheets("Info") DerniereLigne = .Cells(.Rows.Count, 8).End(xlUp).Row With .Range(.Cells(2, 11), .Cells(DerniereLigne, 11)) .FormulaR1C1 = "=SUMPRODUCT((Source!R2C10:R10000C10=Info!RC[-3])*(Source!R2C12:R10000C12=Info!RC[-1]))" .Offset(0, 1).FormulaR1C1 = "=RC[-3]/RC[-1]" End With End With End Sub
Si les valeurs doivent ensuite servir dans d'autres parties du code, vous avez la solution de les mettre dans une matrice.

Merci Eric,
Quelqu'un vient poster une macro dans un autre forum (que j'ai un tout petit adapté) qui marche très bien
Merci pour ton aide.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub TrendDSP_Bis()
 
Dim FeInfo As Worksheet
    Set FeInfo = Worksheets("Info")
Dim TabInfo() As Variant
Set evn = FeInfo.Cells.Find(what:="Vendor Name") 'entete Vendor
 
TabInfo = FeInfo.Range(FeInfo.Cells(2, evn.Column), FeInfo.Cells(FeInfo.Cells(1048576, evn.Column).End(xlUp).Row, evn.Column + 2))
ReDim Preserve TabInfo(LBound(TabInfo, 1) To UBound(TabInfo, 1), LBound(TabInfo, 2) To (UBound(TabInfo, 2) + 1))
 
Dim FeSource As Worksheet
    Set FeSource = Worksheets("Source")
Dim TabSource() As Variant
Set evnS = FeSource.Cells.Find(what:="Vendor Name")
 
TabSource = FeSource.Range(FeSource.Cells(2, evnS.Column - 1), FeSource.Cells(FeSource.Cells(1048576, evnS.Column - 1).End(xlUp).Row, evnS.Column + 2))
ReDim Preserve TabSource(LBound(TabSource, 1) To UBound(TabSource, 1), LBound(TabSource, 2) To (UBound(TabSource, 2) + 1))
 
 
For i = LBound(TabInfo, 1) To UBound(TabInfo, 1)
    For j = LBound(TabSource, 1) To UBound(TabSource, 1)
        If TabInfo(i, 1) & TabInfo(i, 3) = TabSource(j, 2) & TabSource(j, 4) Then
            TabInfo(i, 4) = TabInfo(i, 4) + 1
        End If
    Next j
Next i
 
For i = LBound(TabInfo, 1) To UBound(TabInfo, 1)
    For j = LBound(TabSource, 1) To UBound(TabSource, 1)
        If TabInfo(i, 1) & TabInfo(i, 3) = TabSource(j, 2) & TabSource(j, 4) Then
            TabSource(j, 5) = "=" & TabInfo(i, 2) & "/" & TabInfo(i, 4)
        End If
    Next j
Next i
 
FeSource.Range("D2").Resize(UBound(TabSource, 1), 1).Value = Application.Index(TabSource, , 5)
End Sub