Discussion :

[sims92.66]

Bonjour à tous,

Je suis très content de ce forum très actif qui m'aide à me familiariser à VBA.


Voila mon problème:
J'ai un fichier où je renseigne chaque mois le prix des objets dans un nouveau onglet.
J'aimerai savoir s'il existe une macro pour rechercher tous les objets dont le prix moyen n'a varié que de +/-10% sur la période étudiée (6mois).

J'avais commencé avec excel mais cela s'est avéré fastidieux

Je fais donc appel à votre aide pour m'aider à développer une piste de réflexion.

Merci par avance.

en pj le fichier xl

Pour plus de compréhension le codage serait:

si moyenne du prix objet A est compris entre "prix moyen de l'objet moins 10% et prix moyen de l'objet plus 10%"
alors je prend l'objet A dans onglet résumé

[casefayere]

Bonjour le forum, sims92.66,

Regardes ce code qui vaut ce qu'il vaut mais que tu dois pouvoir adapter si j'ai compris ta demande

D'après ton fichier exemple

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
Sub essai()
Dim Tablo(), Tablo2(), Tablo3(), Fl As Worksheet, Derlg As Long, x As Long
Dim NbArt As Long, z As Long, plage As Range, Rch As Range
Dim Un, cle, montant As Currency
Set Un = CreateObject("Scripting.dictionary")
NbArt = 0: z = 1
montant = 0
For Each Fl In Worksheets
  If Fl.Name <> "resume" Then
    Derlg = Fl.Range("A" & Fl.Rows.Count).End(xlUp).Row
    NbArt = NbArt + Derlg - 1
  End If
Next Fl
ReDim Tablo(1 To NbArt, 1 To 2)
For Each Fl In Worksheets
  If Fl.Name <> "resume" Then
    Derlg = Fl.Range("A" & Fl.Rows.Count).End(xlUp).Row
      For x = 2 To Derlg
        Tablo(z, 1) = Fl.Range("A" & x)
        Tablo(z, 2) = Fl.Range("B" & x)
        z = z + 1
      Next x
  End If
Next Fl
z = 1
ReDim Preserve Tablo2(1 To 1)
On Error Resume Next
For x = 1 To UBound(Tablo)
  If Tablo(x, 1) <> "" Then
    Un.Add Tablo(x, 1), CStr(Tablo(x, 1))
    cle = CStr(Tablo(x, 1))
    If Err = 0 Then
      Tablo2(z) = Tablo(x, 1)
      z = z + 1
      ReDim Preserve Tablo2(1 To z)
    End If
  End If
  Err.Clear
Next x
ReDim Preserve Tablo3(1 To UBound(Tablo2), 1 To 2)
Set Un = Nothing
For x = 1 To UBound(Tablo3, 1)
  Tablo3(x, 1) = Tablo2(x)
  For z = 1 To UBound(Tablo, 1)
    If Tablo(z, 1) = Tablo3(x, 1) Then
      montant = montant + Tablo(z, 2)
      Tablo3(x, 2) = montant / 6
    End If
  Next z
  montant = 0
Next x
Sheets("resume").Range(Cells(2, 1), Cells(UBound(Tablo3, 1), 2)) = Tablo3
For Each Fl In Worksheets
  Derlg = Fl.Range("A" & Fl.Rows.Count).End(xlUp).Row
  For x = 2 To Derlg
    Set plage = Fl.Range("A2:A" & Derlg)
    Set Rch = plage.Find(Sheets("resume").Range("A" & x))
    If Not Rch Is Nothing Then
      If Rch(1, 2) > Sheets("resume").Range("C" & x) Or Rch(1, 2) < Sheets("resume").Range("D" & x) Then
        Sheets("resume").Range("E" & x) = "ECART IMPORTANT": Exit For
      Else
        Sheets("resume").Range("E" & x) = "ECART CORRECT"
      End If
    End If
  Next x
Next Fl
 
End Sub

[sims92.66]

Bonjour casefayere,

Merci pour ton aide.

le but de la macro est de savoir si l'objet est bien présent lors de la période étudié, c'est à dire si l'objet est présent dans tous les onglets mois (janv, fev, mars...)
si oui alors savoir si son prix n'a pas évolué de + de 10% sur la période.
si oui alors prendre cet objet et le renseigné dans la feuille résumé

Par exemple.
prix en janvier prix en fev prix en mars prix en avril prix en mai prix en juin
objet A 10 9 10.5 9.5 11 9.5

le prix de l'objet A n'a pas évolué de plus 10% donc je le renseigne dans ma feuille résumé.

Je ne sais pas si j'ai été clair....

[casefayere]

Donc, ça correspond au code que je propose, essayes-le avec le fichier que tu as inseré dans ton 1er post, bien sur il faudra l'adapter

excuses-moi, j'ai oublié de préciser que j'ai mis des formules en C et D que j'ai tirées vers le bas
sur la feuille "resume"
en C :

Code :

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

=B2*110/100

en D :

Code :

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

 =B2*90/100

[sims92.66]

Merci encore pour ton code mais je l'ai essayé et il ne me remonte que l'objet A, il devrait également remonter l'objet B et C car ils sont présents sur les 6 feuilles et leurs prix ne varient de +10%

[casefayere]

je ne comprends pas, alors je t'envoie ton fichier avec mon travail

[casefayere]

j'ai tranformé légèrement cette partie :

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
.....
ReDim Preserve Tablo3(1 To UBound(Tablo2), 1 To 2)
Set Un = Nothing
For x = 1 To UBound(Tablo3, 1)
  Tablo3(x, 1) = Tablo2(x)
  For z = 1 To UBound(Tablo, 1)
    If Tablo(z, 1) = Tablo3(x, 1) Then
      nb = nb + 1 ' ajouté
      montant = montant + Tablo(z, 2)
      Tablo3(x, 2) = montant / nb 'modifié
    End If
  Next z
  montant = 0: nb = 0
Next x
.....

fais un copier/coller

a +

J'ai encore modifié ton programme en éliminant les formules qui ne servent pas à grand-chose,

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
.....
On Error GoTo 0
nb = 0
ReDim Preserve Tablo3(1 To UBound(Tablo2), 1 To 4) 'ici changement
Set Un = Nothing
For x = 1 To UBound(Tablo3, 1)
  Tablo3(x, 1) = Tablo2(x)
  For z = 1 To UBound(Tablo, 1)
    If Tablo(z, 1) = Tablo3(x, 1) Then
      nb = nb + 1 ' ajouté
      montant = montant + Tablo(z, 2)
      Tablo3(x, 2) = montant / nb 'modifié
      Tablo3(x, 3) = Tablo(x, 2) * 1.1 'ici changement
      Tablo3(x, 4) = Tablo(x, 2) * 0.9 'ici changement
    End If
  Next z
  montant = 0: nb = 0
Next x
With Sheets("resume")
  .Range(.Cells(2, 1), .Cells(UBound(Tablo3, 1), 4)) = Tablo3 'ici changement
  Derlg = .Range("A" & .Rows.Count).End(xlUp).Row
  Set plage = .Range("A2:A" & Derlg)
  nb = 0
  For Each cel In plage
    For x = 1 To UBound(Tablo)
      If cel = Tablo(x, 1) Then
        If Tablo(x, 2) > cel(1, 3) Or Tablo(x, 2) < cel(1, 4) Then
          cel(1, 5) = "ECART IMPORTANT": Exit For
        Else
          cel(1, 5) = "ECART CORRECT"
        End If
      End If
    Next x
  Next cel
End With
 
End Sub