XL 2016 Compter le nombre d’occurrence

aba2s

XLDnaute Junior
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 d'avance pour votre aide
 

Pièces jointes

  • TestSample.xlsm
    19.5 KB · Affichages: 13

eriiic

XLDnaute Barbatruc
Bonjour,

un TCD te fait ça en 10s pour tous tes IO, sans macro, sans formule.
Mais il faut nommer tous les champs.
Tableau Croisé Dynamique (TCD) : http://www.mdf-xlpages.com/modules/smartsection/item.php?itemid=109

Ou bien tu transforme ta BDD en Tableau (Insertion / Tableau), et pour sélectionner la colonne (en édition de formule) tu mets le curseur au-dessus de son titre. Tu cliques quand il se transforme en flèche vers le bas. La référence structurée s'adaptera toute seule au nombre de lignes du Tableau.
eric
 
Dernière édition:

laurent950

XLDnaute Accro
Bonsoir Eric,
J'étais partie sur l'idée que le tableau Info n'avais pas de doublon sur chacune des lignes, mais en faite je pense qu'il y a des doublons
les deux clefs : Vendor Name et Insertion Orders (Ne suffise pas) voir ligne 2 et 9 du tableau Info.

Dynadmic10 000,00 €2019-02 - Television - CRV Hybrid - Mob. + tab. - Vid. pre-roll - VTR
Dynadmic1 800,00 €2019-02 - Television - CRV Hybrid - Mob. + tab. - Vid. pre-roll - VTR

Donc :
Solution avec l'idée que le tableau [Je parle du tableau Info] n'a de doublons.
C'est à dire que pour la clef : Vendor Name et Insertion Orders (La concaténation des deux formes une clef primaire qui sera donc unique pour le tableau et donc se tableau ne comporte pas de doublon soit un prix pour chaque article.

Restitution dans la feuille source cette fois ci le nombre d'article qui correspond à la clef : Vendor Name et Insertion Orders.
Résultat : Nombres d'article divisé par le prix du tableau Info.

Pour le module :
J'étais partie sur cela :
VB:
Sub TrendDSP_Bis()

Dim FeInfo As Worksheet
    Set FeInfo = Worksheets("Info")
Dim TabInfo() As Variant
TabInfo = FeInfo.Range(FeInfo.Cells(2, 8), FeInfo.Cells(FeInfo.Cells(65536, 8).End(xlUp).Row, 10))
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
TabSource = FeSource.Range(FeSource.Cells(2, 9), FeSource.Cells(FeSource.Cells(65536, 9).End(xlUp).Row, 12))
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
Cdt
Laurent
 
Dernière édition:

aba2s

XLDnaute Junior
Bonjour Eric et Laurent,
Merci beaucoup pour votre.

@laurent950 ta macro marche parfaitement. En fait tu as raison il n'y a pas de doublon.C'était une erreur de ma part.

@eriiiic le bloc sur les TCD est très intéressant. Je regarderai en détails afin d'en tirer le maximum de profit.

Merci à tous les inscrits, on apprend vraiment.
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour aba2s, eriiiic, laurent950,

Une solution par formule en D2, à tirer vers le bas :

Code:
=SOMMEPROD((J2&L2=Info!H$2:H$16&Info!J$2:J$16)*Info!I$2:I$16)/NB.SI.ENS(J$2:J$173;J2;L$2:L$173;L2)

20 cellules donnent des résultats différents de la solution de Laurent car les doublons sont traités différemment (SOMMEPROD additionne les valeurs).

A+
 

aba2s

XLDnaute Junior
@laurent950 Hello Laurant,
Je souhaitera ajouter les valeurs sDay et eDay correspondant sans avoir à recréer une nouvelle. J'ai essayé d'adapter ta macro mais je ne maitrise pas les tableaux. Je m'y pencherai à tête reposer.

VB:
Sub TrendDSP()

Application.ScreenUpdating = False

Dim j, col As Integer

Dim campaign, dsp, entete As Range

col = 4

s = 0

ActiveWorkbook.Sheets("Info").Activate

Set entete = Sheets("Info").Cells.Find(what:="Vendor Name")

    

    For j = entete.Row + 1 To Sheets("Info").Range("H" & Rows.Count).End(xlUp).Row

     Set dsp = Sheets("Source").Columns("J").Find(what:=Sheets("Info").Range("H" & j))

         If Not dsp Is Nothing Then

         Depart = dsp.Address

         Do

      

         If Sheets("Info").Range("H" & j).Offset(, 2) Like dsp.Offset(, 2) Then

          s = s + 1

          Sheets("Source").Cells(dsp.Row, col) = Sheets("Info").Range("H" & j).Offset(, 1) / s

          Sheets("Source").Cells(dsp.Row, col + 1) = Sheets("Info").Range("H" & j).Offset(, -6)

          Sheets("Source").Cells(dsp.Row, col + 2) = Sheets("Info").Range("H" & j).Offset(, -5)

      

        

          End If

          Set dsp = Sheets("Source").Columns("J").FindNext(dsp)

          Loop While Not dsp Is Nothing And Depart <> dsp.Address

         End If

      

       Next j

ActiveWorkbook.Sheets("Source").Activate

Columns("E").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"

Columns("F").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"

Columns("G").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"



' ActiveWorkbook.Sheets("Info").Activate

End Sub
 

aba2s

XLDnaute Junior
Ce sont des dates de début et de fin pour chaque "Insertion Orders" ou "IO name".
Je voudrai pour chaque insertion order de la feuille info trouvée dans la feuille source, mettre la date dans cette dernière (colonne F et G).
Merci
VB:
Sub TrendDSP()
Application.ScreenUpdating = False
Dim j, col As Integer
Dim campaign, dsp, entete As Range
col = 4
s = 0
ActiveWorkbook.Sheets("Info").Activate
Set entete = Sheets("Info").Cells.Find(what:="Vendor Name")
        For j = entete.Row + 1 To Sheets("Info").Range("H" & Rows.Count).End(xlUp).Row
     Set dsp = Sheets("Source").Columns("J").Find(what:=Sheets("Info").Range("H" & j))

         If Not dsp Is Nothing Then
         Depart = dsp.Address
         Do
            If Sheets("Info").Range("H" & j).Offset(, 2) Like dsp.Offset(, 2) Then
          s = s + 1
          Sheets("Source").Cells(dsp.Row, col) = Sheets("Info").Range("H" & j).Offset(, 1) / s
          Sheets("Source").Cells(dsp.Row, col + 1) = Sheets("Info").Range("H" & j).Offset(, -6)
          Sheets("Source").Cells(dsp.Row, col + 2) = Sheets("Info").Range("H" & j).Offset(, -5)
          End If
          Set dsp = Sheets("Source").Columns("J").FindNext(dsp)
          Loop While Not dsp Is Nothing And Depart <> dsp.Address
         End If
       Next j
ActiveWorkbook.Sheets("Source").Activate
Columns("E").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"
Columns("F").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"
Columns("G").NumberFormat = "[$-fr-FR]d-mmm-yyyy;@"
' ActiveWorkbook.Sheets("Info").Activate

End Sub
 

Pièces jointes

  • TestSample.xlsm
    20.4 KB · Affichages: 3

laurent950

XLDnaute Accro
Je sais pas qu'elle action il faut faire, vous pouvez dérouler le principe et expliquer
un exemple écrit en dur dans la feuille excel joint (Donné entrée / se qu'il faut faire avec / puis donnée de sortie résultat

ce que j'ai compris c'est de récupérer la date la plus anciennes et la plus récente dans le tableau source en rapport avec l'article dans la feuille Info
et coller le résultat dans la feuille Info ?

cdt
 

aba2s

XLDnaute Junior
Merci @laurent950 !
Je m'explique.Par exemple si je prend dans la feuille info l'Insertion Order suivant
2019-02 - Television - CRV Hybrid - Mob. + tab. - Vid. pre-roll - VTR
Sur le vendor Name:
- Dynadmique: sa date de démarrage (sDay) c'est le 04/03/2019 et date de fin (eDay) c'est le 30/03/2019
DBM : sa date de démarrage (sDay) c'est le 05/03/2019 et date de fin (eDay) c'est le 31/03/2019
Je voudrai rapporter ces valeurs (sDay et eDay) dans la feuille source pour toutes les insertions Orders.
J'ai mis le résultat que je voudrai avoir dans la feuille source.
C'est plus clair?
Ce que je souhaite c'est garder ta macro en ajoutant ces valeurs de date aulien de créer une nouvelle macro pour ne surcharger mon fichier.
Merci beaucoup d'avance.
 

Pièces jointes

  • TestSample.xlsm
    24.6 KB · Affichages: 7

laurent950

XLDnaute Accro
Bonsoir,

J'ai commenté le code comme j'ai pu, en espérant que cela vous serve.
VB:
Sub TrendDSP_Bis()
' Mise en mémoire de la feuille Info
Dim FeInfo As Worksheet
    Set FeInfo = Worksheets("Info")
' Création d'une variable tableau 2 dimenssion
Dim TabInfo() As Variant
' Plage de du tableau dans la feuille info a stocké dans la variable tableau !
TabInfo = FeInfo.Range(FeInfo.Cells(3, 2), FeInfo.Cells(FeInfo.Cells(65536, 8).End(xlUp).Row, 10))
' comme les données sont stocké dans une variable tableau
' Se ne sont plus les valeur de la feuille excel car transféré dans cette variable
' il faut ajouté une colonne pour stocké les valeurs de recherches trouvé soit
' un redim preserve / c'est a dire ont conserve toute les valeurs du tableau et ont affecte une colonne suplémentaire
' LBound(TabInfo, 1) = 1 ligne, de la premiere colonne
' UBound(TabInfo, 1) = Derniere ligne de la premiere colonne
' LBound(TabInfo, 2) = 1 ere colonne du tableau
' UBound(TabInfo, 2 = Derniére colonne du tableau
' se qui corespond au valeur de la plage du tableau feuille info soit : FeInfo.Range(FeInfo.Cells(3, 2), FeInfo.Cells(FeInfo.Cells(65536, 8).End(xlUp).Row, 10))
' Ensuite j'affecte une autre colonne d'ou le +1
ReDim Preserve TabInfo(LBound(TabInfo, 1) To UBound(TabInfo, 1), LBound(TabInfo, 2) To (UBound(TabInfo, 2) + 1))

' Idem même principe
Dim FeSource As Worksheet
    Set FeSource = Worksheets("Source")
Dim TabSource() As Variant
TabSource = FeSource.Range(FeSource.Cells(2, 9), FeSource.Cells(FeSource.Cells(65536, 9).End(xlUp).Row, 12))
ReDim Preserve TabSource(LBound(TabSource, 1) To UBound(TabSource, 1), LBound(TabSource, 2) To (UBound(TabSource, 2) + 1))

' systéme de boucle simple !
' Compte le nombre de ligne dans le tableau source qui sont identique au tableau info
' dans la colonne crée du tableau info (Redim preserve +1) selon mes explication
' je fait un compteur dans cette colonne
' et chcunes des lignes qui sont reperer dans le tableau source (sur le même principe de céation que l'explication du tableau info)
' une fois la igne selon une clef primaire créer au moyen de concatenation (Vendor Name & Insertion Orders)
' je connais le nombre de ligne que je stocke dans le tableau info

For i = LBound(TabInfo, 1) To UBound(TabInfo, 1)
    For j = LBound(TabSource, 1) To UBound(TabSource, 1)
        If TabInfo(i, 7) & TabInfo(i, 9) = TabSource(j, 2) & TabSource(j, 4) Then
            TabInfo(i, 10) = TabInfo(i, 10) + 1
        End If
    Next j
Next i

' il n'y a plus cas faire une boucle sur le tableau info sur le même principe
' de cléf primaire créer
' puis devant chaque ligne du tableau source qui correspond au tableau info
' le montant info memtioné des la base puis se servire de cette colonne nouvelle ou sont stocké le nombre de
' ligne identique (boucle précédente) ont divive le montant par le nombre de ligne trouvé identique.
For i = LBound(TabInfo, 1) To UBound(TabInfo, 1)
    For j = LBound(TabSource, 1) To UBound(TabSource, 1)
        If TabInfo(i, 7) & TabInfo(i, 9) = TabSource(j, 2) & TabSource(j, 4) Then
            TabSource(j, 5) = "=" & TabInfo(i, 8) & "/" & TabInfo(i, 10)
        End If
    Next j
Next i


' restitution des données dans la feuille source.
' je restitu jsute la colonne créer au moyen du redim preserve
' soit la colonne N°5
FeSource.Range("D2").Resize(UBound(TabSource, 1), 1).Value = Application.Index(TabSource, , 5)


' maintenant ont doit retrouvé les dates donc le tableau source n'a pas assez de colonne
' (UBound(TabSource, 2) = le nombre total de colonne ici 5 colonnes
' donc plus 2 colonnes pour les dates eDay et sDay
' la tableau source a maintenant 7 colonnes
ReDim Preserve TabSource(LBound(TabSource, 1) To UBound(TabSource, 1), LBound(TabSource, 2) To (UBound(TabSource, 2) + 2))
' donc le tableau source a 7 colonnes maintenant (le deux derniere vide que l'on va remplire ci-desous

'suite idem : Même principe clef primaire créer / recherche et ont colle dans les deux colonnes créer
' du tableau source les dates de valeurs du tableau info.
' C'est un peux le même principe.
' Ps : pour les dates copier dans une variable tableau et restituer dans une feuilles excel
' parfois les resultats sont pas identique donc
' la valeur trouver dans excel avant d'etre stocker dans la variable tableau et transformer
' en date avec Cdate
' et ont affecte un format de type internationnal avec
' Format(LaVariabledtate,, "yyyy-mm-dd")
' ps : Il y a un lien qui explique dans le commentaire a l'endroit que cela interesse.
For i = LBound(TabSource, 1) To UBound(TabSource, 1)
    For j = LBound(TabInfo, 1) To UBound(TabInfo, 1)
        If TabInfo(j, 7) & TabInfo(j, 9) = TabSource(i, 2) & TabSource(i, 4) Then
            ' un peux compliqué les format date donc un lien
            ' https://www.developpez.net/forums/d1544905/logiciels/microsoft-office/excel/macros-vba-excel/format-certaines-dates-change-apres-traitement-variable-tableau/
            TabSource(i, 6) = Format(CDate(TabInfo(j, 1)), "yyyy-mm-dd")
            TabSource(i, 7) = Format(CDate(TabInfo(j, 2)), "yyyy-mm-dd")
        End If
    Next j
Next i

'Idem ont restitu les resultat
'sDay
FeSource.Range("E2").Resize(UBound(TabSource, 1), 1).Value = Application.Index(TabSource, , 6)
'eDay
FeSource.Range("F2").Resize(UBound(TabSource, 1), 1).Value = Application.Index(TabSource, , 7)
End Sub

Ps : Pour les format date et variable tableau : https://www.developpez.net/forums/d...tes-change-apres-traitement-variable-tableau/

Cdt
Laurent
 

Pièces jointes

  • TestSampleBis.xlsm
    42.4 KB · Affichages: 2
Dernière édition: