Comparaison automatique des prix concurrents

**idate** · 12/05/2014, 12h27

Bonjour,

Je souhaite créer un outil qui permet d'identifier les produits sur lesquels mes concurrents sont moins chers que moi à une date donnée et sur un pays donné.

J'ai en entrée : id produit, pays, nom du concurrent, prix produit, date

La macro devra permettre à l'utilisateur de choisir une date dans une liste d'un formulaire contenant l'ensemble des dates (dédoublonnées) du fichier. Lorsque l'utilisateur aura choisit sa date et cliquer sur un bouton "Valider", la macro doit créer un onglet pour chaque pays sur lequel figure l'ensemble des id produits (et informations de ligne associées) qui ont un "prix produit" inférieur au notre.

Je pense avoir besoin de beaucoup de fonctions VBA différentes, je vous soumets mon analyse descendante:

1) Stocker dans un tableau l'ensemble des pays (dédoublonnés)
2) Stocker dans un tableau l'ensemble des dates (dédoublonnées)
3) Afficher dans un formulaire, une liste des dates dédoublonnées
4) A la validation de la date sur le formulaire,

4a) Stocker l'ensemble des lignes nous concernant (ayant comme "nom de concurrent" : Mon entreprise) dans un tableau
4b) Pour chaque "pays", pour chaque id produit, afficher le prix et le nom du concurrent le moins cher dans un onglet "pays". Si c'est Mon entreprise le moins cher, ne pas afficher la ligne
4c) A côté de chaque prix concurrents affichés, afficher aussi le prix de Mon entreprise pour ce produit

Techniquement :

1) + 2) => Je pense utiliser les dictionnaires de la façon suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim Tab_date()
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A15].End(xlUp))
'si la donnée n'existe pas encore dans le dictionnaire
     If Not MonDico.Exists(c.Value) Then
'on l'ajoute dans le dictionnaire...
        MonDico.Add c.Value, c.Value
'...et dans le tableau VBA ;-)
        ReDim Tab_date(1 To MonDico.Count)
        Tab_date(MonDico.Count) = c.Value
        Debug.Print MonDico.Count, Tab_date(MonDico.Count)
      End If
  Next c

Cependant, mon for each c ne boucle pas...

3) J'utiliserai une listbox avec ce que contient mon tableau tab_date

4a) Utiliser un AutoFilter pour filtrer les données brutes par date (date choisie dans la listbox) et par nom de concurrent (Mon entreprise) et stocker les données filtrées dans un tableau current_price

4b) Créer un onglet pour chaque pays, boucler sur chaque id produit d'un pays, identifier le nom du concurrent le moins cher et stocker la ligne correspondante dans l'onglet du pays => Sur ce point la, avez-vous des idées quant à la réalisation de cette fonction de comparaison?

4c) Un rechercheV version VBA devrait suffire pour aller chercher le prix dans la table current_price

L'enchainement des différentes étapes vous semble t-elle pertinente ? Si non, quelles autres façons de faire seraient possibles? Avez-vous des idées efficaces pour la réalisation de la fonction 4b) ?

Je vous joins un fichier sur lequel apparaît un échantillon de mes données d'entrée. données_brutes.xlsx

Modif : Voici mon code actuel (qui est vraiment très lent...) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
Sub Macro1()
 
'Declaration des variables
Dim Tab_asin(), tab_tmp(), tab_domo(), tab_market()
Dim sku, Asin, market, vendeur, prix, fba, Date_file, note
Dim Lastlig
Dim l
Dim p
Dim q
Dim domo
Dim r1
Dim r2
 
Application.ScreenUpdating = False
'Entetes feuille 2
With Worksheets("Feuil2")
    .Cells(1, 1) = "SKU"
    .Cells(1, 2) = "ASIN"
    .Cells(1, 3) = "Marketplace"
    .Cells(1, 4) = "Nom_vendeur"
    .Cells(1, 5) = "Prix"
    .Cells(1, 6) = "FBA"
    .Cells(1, 7) = "Date"
    .Cells(1, 8) = "Note_du_vendeur"
    .Cells(1, 9) = "Notre prix"
End With
 
'Entetes feuille 3
With Worksheets("Feuil3")
    .Cells(1, 1) = "SKU"
    .Cells(1, 2) = "ASIN"
    .Cells(1, 3) = "Marketplace"
    .Cells(1, 4) = "Nom_vendeur"
    .Cells(1, 5) = "Prix"
    .Cells(1, 6) = "FBA"
    .Cells(1, 7) = "Date"
    .Cells(1, 8) = "Note_du_vendeur"
End With
 
'Dictionnaire market
With Worksheets("Feuil1")
  Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
  Set marketDico = CreateObject("Scripting.Dictionary")
  For f = 2 To Lastlig
    If Not marketDico.Exists(.Cells(f, 3).Value) Then
    marketDico.Add .Cells(f, 3).Value, .Cells(f, 3).Value
        ReDim Preserve tab_market(1 To marketDico.Count)
        tab_market(marketDico.Count) = .Cells(f, 3).Value
        'Debug.Print MonDico.Count, Tab_asin(MonDico.Count)
    End If
  Next f
End With
 
'Stockage DOMO EXPRESS
With Worksheets("Feuil1")
        q = 0
        l2 = 2
        While l2 <= Lastlig
            If .Cells(l2, 4) = "DOMO EXPRESS" Then
            q = q + 1
            ReDim Preserve tab_domo(1 To 8, 1 To q)
            tab_domo(1, q) = .Cells(l2, 1)
            tab_domo(2, q) = .Cells(l2, 2)
            tab_domo(3, q) = .Cells(l2, 3)
            tab_domo(4, q) = .Cells(l2, 4)
            tab_domo(5, q) = .Cells(l2, 5)
            tab_domo(6, q) = .Cells(l2, 6)
            tab_domo(7, q) = .Cells(l2, 7)
            tab_domo(8, q) = .Cells(l2, 8)
            End If
            l2 = l2 + 1
        Wend
End With
 
With Worksheets("Feuil3")
 
For r1 = 1 To UBound(tab_domo, 1)
    For r2 = 1 To UBound(tab_domo, 2)
    .Cells(r2 + 1, r1) = tab_domo(r1, r2)
    Next r2
Next r1
 
End With
 
With Worksheets("Feuil1")
 
'Dictionnaire ASIN
  Set MonDico = CreateObject("Scripting.Dictionary")
  For k = 2 To Lastlig
    If Not MonDico.Exists(.Cells(k, 2).Value) Then
    MonDico.Add .Cells(k, 2).Value, .Cells(k, 2).Value
        ReDim Preserve Tab_asin(1 To MonDico.Count)
        Tab_asin(MonDico.Count) = .Cells(k, 2).Value
        'Debug.Print MonDico.Count, Tab_asin(MonDico.Count)
    End If
  Next k
End With
 
t = 1
 
'Creation du tableau temporaire par ASIN
For i = 1 To UBound(Tab_asin, 1)
    p = 0
    l = 2
    domo = 0
    ReDim tab_tmp(1 To 8, 1 To 1)
    With Worksheets("Feuil1")
        While l <= Lastlig
            If .Cells(l, 2) = Tab_asin(i) Then
            p = p + 1
            ReDim Preserve tab_tmp(1 To 8, 1 To p)
            tab_tmp(1, p) = .Cells(l, 1)
            tab_tmp(2, p) = .Cells(l, 2)
            tab_tmp(3, p) = .Cells(l, 3)
            tab_tmp(4, p) = .Cells(l, 4)
            If tab_tmp(4, p) = "DOMO EXPRESS" Then domo = 1
            tab_tmp(5, p) = .Cells(l, 5)
            tab_tmp(6, p) = .Cells(l, 6)
            tab_tmp(7, p) = .Cells(l, 7)
            tab_tmp(8, p) = .Cells(l, 8)
            End If
            l = l + 1
        Wend
    End With
 
    If domo = 1 Then
    'Comparaison des prix du tableau
    sku = tab_tmp(1, 1)
    Asin = tab_tmp(2, 1)
    market = tab_tmp(3, 1)
    vendeur = tab_tmp(4, 1)
    prix = tab_tmp(5, 1)
    fba = tab_tmp(6, 1)
    Date_file = tab_tmp(7, 1)
    note = tab_tmp(8, 1)
    For j = 2 To UBound(tab_tmp, 2)
        If prix > tab_tmp(5, j) Then
        sku = tab_tmp(1, j)
        Asin = tab_tmp(2, j)
        market = tab_tmp(3, j)
        vendeur = tab_tmp(4, j)
        prix = tab_tmp(5, j)
        fba = tab_tmp(6, j)
        Date_file = tab_tmp(7, j)
        note = tab_tmp(8, j)
        End If
    Next j
 
    'Ecriture du prix le moins cher
    With Worksheets("Feuil2")
    If vendeur <> "DOMO EXPRESS" Then
    t = t + 1
        .Cells(t, 1) = sku
        .Cells(t, 2) = Asin
        .Cells(t, 3) = market
        .Cells(t, 4) = vendeur
        .Cells(t, 5) = prix
        .Cells(t, 6) = fba
        .Cells(t, 7) = Date_file
        .Cells(t, 8) = note
        .Cells(t, 9) = WorksheetFunction.VLookup(Asin, Sheets("Feuil3").Range("A1:C5000"), 5, False)
    End If
    End With
    End If
Next i
 
End Sub

Merci d'avance

Cordialement, idate.

**idate** · 13/05/2014, 10h23

Bonjour,

Je reviens vers vous avec un gros travail d'achevé. Le programme décrit précédemment fonctionne bien dans le sens où les résultats renvoyés par la macro sont exacts.
Cependant, je trouve le programme plutôt long (environ 70sec pour traiter un fichier source de 4000 lignes).

J'aimerais avoir des avis ou conseils à propos des parties de mon code à optimiser pour réduire ce temps d’exécution si possible de moitié.

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
Sub Macro1()
 
'Declaration des variables
Dim Tab_asin(), tab_tmp(), tab_domo(), tab_market(), tab_tmp_market()
Dim sku, Asin, market, vendeur, prix, fba, Date_file, note
Dim Lastlig
Dim l
Dim p
Dim q
Dim domo
Dim r1
Dim r2
 
Application.ScreenUpdating = False
 
'Entetes feuille 3
With Worksheets("Feuil3")
    .Cells(1, 1) = "SKU"
    .Cells(1, 2) = "ASIN"
    .Cells(1, 3) = "Marketplace"
    .Cells(1, 4) = "Nom_vendeur"
    .Cells(1, 5) = "Prix"
    .Cells(1, 6) = "FBA"
    .Cells(1, 7) = "Date"
    .Cells(1, 8) = "Note_du_vendeur"
End With
 
'Dictionnaire market
With Worksheets("Feuil1")
  Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
  Set marketDico = CreateObject("Scripting.Dictionary")
  For f = 2 To Lastlig
    If Not marketDico.Exists(.Cells(f, 3).Value) Then
    marketDico.Add .Cells(f, 3).Value, .Cells(f, 3).Value
        ReDim Preserve tab_market(1 To marketDico.Count)
        tab_market(marketDico.Count) = .Cells(f, 3).Value
        'Debug.Print MonDico.Count, Tab_asin(MonDico.Count)
    End If
  Next f
End With
 
'Stockage DOMO EXPRESS
With Worksheets("Feuil1")
        q = 0
        l2 = 2
        While l2 <= Lastlig
            If .Cells(l2, 4) = "DOMO EXPRESS" Then
            q = q + 1
            ReDim Preserve tab_domo(1 To 8, 1 To q)
            tab_domo(1, q) = .Cells(l2, 1)
            tab_domo(2, q) = .Cells(l2, 2)
            tab_domo(3, q) = .Cells(l2, 3)
            tab_domo(4, q) = .Cells(l2, 4)
            tab_domo(5, q) = Replace(.Cells(l2, 5), ".", ",")
            tab_domo(6, q) = .Cells(l2, 6)
            tab_domo(7, q) = .Cells(l2, 7)
            tab_domo(8, q) = .Cells(l2, 8)
            End If
            l2 = l2 + 1
        Wend
End With
 
With Worksheets("Feuil3")
 
For r1 = 1 To UBound(tab_domo, 1)
    For r2 = 1 To UBound(tab_domo, 2)
    .Cells(r2 + 1, r1) = tab_domo(r1, r2)
    Next r2
Next r1
 
End With
 
For g = 1 To UBound(tab_market, 1)
o = 0
e = 2
Sheets.Add.Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = tab_market(g)
ReDim tab_tmp_market(1 To 8, 1 To 1)
With Worksheets("Feuil1")
    While e < Lastlig
        If .Cells(e, 3) = tab_market(g) Then
        o = o + 1
        ReDim Preserve tab_tmp_market(1 To 8, 1 To o)
        tab_tmp_market(1, o) = .Cells(e, 1)
        tab_tmp_market(2, o) = .Cells(e, 2)
        tab_tmp_market(3, o) = .Cells(e, 3)
        tab_tmp_market(4, o) = .Cells(e, 4)
        tab_tmp_market(5, o) = Replace(.Cells(e, 5), ".", ",")
        tab_tmp_market(6, o) = .Cells(e, 6)
        tab_tmp_market(7, o) = .Cells(e, 7)
        tab_tmp_market(8, o) = .Cells(e, 8)
        End If
        e = e + 1
    Wend
End With
 
With Worksheets("Feuil1")
'Dictionnaire ASIN
  Set MonDico = CreateObject("Scripting.Dictionary")
  For k = 1 To UBound(tab_tmp_market, 2)
    If Not MonDico.Exists(tab_tmp_market(2, k)) Then
    MonDico.Add tab_tmp_market(2, k), tab_tmp_market(2, k)
        ReDim Preserve Tab_asin(1 To MonDico.Count)
        Tab_asin(MonDico.Count) = tab_tmp_market(2, k)
        'Debug.Print MonDico.Count, Tab_asin(MonDico.Count)
    End If
  Next k
End With
 
t = 1
 
'Creation du tableau temporaire par ASIN
For i = 1 To UBound(Tab_asin, 1)
    p = 0
    l = 1
    domo = 0
    ReDim tab_tmp(1 To 8, 1 To 1)
        While l <= UBound(tab_tmp_market, 2)
            If tab_tmp_market(2, l) = Tab_asin(i) Then
            p = p + 1
            ReDim Preserve tab_tmp(1 To 8, 1 To p)
            tab_tmp(1, p) = tab_tmp_market(1, l)
            tab_tmp(2, p) = tab_tmp_market(2, l)
            tab_tmp(3, p) = tab_tmp_market(3, l)
            tab_tmp(4, p) = tab_tmp_market(4, l)
            If tab_tmp(4, p) = "DOMO EXPRESS" Then domo = 1
            tab_tmp(5, p) = tab_tmp_market(5, l)
            tab_tmp(6, p) = tab_tmp_market(6, l)
            tab_tmp(7, p) = tab_tmp_market(7, l)
            tab_tmp(8, p) = tab_tmp_market(8, l)
            End If
            l = l + 1
        Wend
 
    If domo = 1 Then
    'Comparaison des prix du tableau
    sku = tab_tmp(1, 1)
    Asin = tab_tmp(2, 1)
    market = tab_tmp(3, 1)
    vendeur = tab_tmp(4, 1)
    prix = tab_tmp(5, 1)
    fba = tab_tmp(6, 1)
    Date_file = tab_tmp(7, 1)
    note = tab_tmp(8, 1)
    For j = 2 To UBound(tab_tmp, 2)
        If prix > tab_tmp(5, j) Then
        sku = tab_tmp(1, j)
        Asin = tab_tmp(2, j)
        market = tab_tmp(3, j)
        vendeur = tab_tmp(4, j)
        prix = tab_tmp(5, j)
        fba = tab_tmp(6, j)
        Date_file = tab_tmp(7, j)
        note = tab_tmp(8, j)
        End If
    Next j
 
    'Ecriture du prix le moins cher
    With Worksheets(tab_market(g))
    If vendeur <> "DOMO EXPRESS" And prix <> WorksheetFunction.VLookup(Asin, Sheets("Feuil3").Range("B1:E5000"), 4, False) Then
    t = t + 1
        .Cells(1, 1) = "SKU"
        .Cells(1, 2) = "ASIN"
        .Cells(1, 3) = "Marketplace"
        .Cells(1, 4) = "Nom_vendeur"
        .Cells(1, 5) = "Prix"
        .Cells(1, 6) = "FBA"
        .Cells(1, 7) = "Date"
        .Cells(1, 8) = "Note_du_vendeur"
        .Cells(1, 9) = "Notre prix"
        .Cells(1, 10) = "Notre marge"
        .Cells(t, 1) = sku
        .Cells(t, 2) = Asin
        .Cells(t, 3) = market
        .Cells(t, 4) = vendeur
        .Cells(t, 5) = prix
        .Cells(t, 6) = fba
        .Cells(t, 7) = Date_file
        .Cells(t, 8) = note
        .Cells(t, 9) = WorksheetFunction.VLookup(Asin, Sheets("Feuil3").Range("B1:E5000"), 4, False)
    End If
    End With
    End If
Next i
Next g
End Sub

Je pense qu'une première optimisation est dans l'utilisation d'un tableau pour stocker les valeurs que j'écris dans ma feuille 3. En fait, j'écris dans cette feuille 3 pour pouvoir faire un recherchev() dans celle-ci. Un recherchev() ou un équivalent peut-il fonctionner avec un tableau?

Voyez-vous d'autres optimisations susceptibles de réduire le temps d’exécution de cette macro ?

merci d'avance

Cordialement, idate.

**letudiant68** · 13/05/2014, 11h03

Bonjour je ne suis pas un spécialiste mais il me semble qu'il vaut mieux éviter les ReDim de tableaux qui consomment énormément de ressources (surtout dans une boucle).
Voici un lien vers un site qui propose pas mal d'astuce pour optimiser son code : http://fordom.free.fr/tuto/OPTIMISATION.htm

**idate** · 13/05/2014, 11h36

Merci pour ta réponse letudiant68.

J'ai parcouru ton lien et est appliqué certains des conseils présents comme :

Ajouter un option Explicit en début de module
Définir l'ensemble de mes variables
Fixer la taille de certains tableaux ( et donc ne plus utiliser de ReDim (Preserve))

Il s'avère que la macro ne met plus 70sec mais 10 fois plus de temps^^

Je ne vois pas pourquoi...

**letudiant68** · 13/05/2014, 13h18

10 fois plus de temps? Étrange... Sinon ce que tu peux faire c'est mettre une sorte de chronomètre à divers endroit de la macro (hors des boucles) pour voir quelle partie met le plus de temps à s'exécuter et par conséquent qu'il faudrait améliorer en priorité :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim chrono as Date
chrono = Now
'...
'...
'...
Debug.Print(Format(Now - chrono, "hh:mm:ss")) 'voir fenêtre d'exécution (CTRL + G)

**Marc-L** · 13/05/2014, 14h42

Bonjour,

vis à vis du post #2, désactiver en début de procédure le calcul automatique (consulter l'aide de la propriété Calculation) …

De plus, si des procédures évènementielles sont présentes dans un module d'une feuille de calculs ou dans celui du classeur,
notamment Worksheet_Change, les désactiver aussi (voir la propriété EnableEvents) …

Ne pas oublier de rétablir ces deux propriétés en fin de procédure !

**idate** · 13/05/2014, 15h24

Merci à tous les deux, grâce à vos conseils, j'ai pu réduire le temps d’exécution à 20-30sec.

La dernière étape de ma macro est de pouvoir enregistrer dans un tableau toutes les lignes qui ont la date la plus récente dans leur champ "Date".
Cependant, mes dates sont de format : 29/04/2014 09:05:00

Du coup, comment faire pour filtrer sur la date (la plus récente) seulement?

merci d'avance

EDIT : je crois avoir trouvé la réponse : "si vous voulez la date sans les heures, utiliser Int(CDate(Date1))"

Je compte stocker l'ensemble des dates dans un dictionnaire puis de séléctionner la date la plus récente de ce dictionnaire pour ensuite filtrer mes lignes. Cela vous parait-il pertinent? Y a t-il plus rapide?

Comparaison automatique des prix concurrents

Macros et VBA Excel

Discussions similaires

Partager

Partager