une macro pour calculer la moyenne pondérée

machoucha

XLDnaute Nouveau
Bonjour à tous,
J'ai le fichier suivant : référence, quantité et prix
J'aimerai bien créer une macro qui me permettra pour chaque référence qui se répète d'additionner la quantité et calculer le prix moyen pondéré par la quantité
Par exemple pour la référence 725105913 (colorée en jaune et qui se répète 3 fois) je veux avoir le résultat suivant: quantité= 0,7+1+0,055 et prix moyen pondéré =(0,7+1)*8,45 + (0,055*8,46) et éliminer après les lignes qui se répète

j'ai crée la macro suivante:
Dim Lg As Long
Dim p As Long
Dim Compteur As Integer
Application.ScreenUpdating = False
Lg = Range("A" & Rows.Count).End(xlUp).Row
For p = Lg To 3 Step -1
If Range("A" & p) = Range("A" & p - 1) Then
Compteur = Compteur + 1
Range("B" & p - 1).Value = Range("B" & p) + Range("&" p - 1)
Range("C" & p - 1).Value = Range("C" & p - 1) * Range("B" & p - 1)/ Range("B" & p - 1)
Range("A" & p & ":C" & p).Delete shift:=xlShiftUp
End If
Next p
End Sub
Seulement le problème réside dans le calcul du prix pondéré par la quantité
y'a t-il quelqu'un qui peut m'aider à résoudre ce problème à fin d'obtenir le résultat souhaité. Merci d'avance
 

Pièces jointes

  • fichier 1.xlsx
    11.1 KB · Affichages: 75
  • fichier 1.xlsx
    11.1 KB · Affichages: 81
  • fichier 1.xlsx
    11.1 KB · Affichages: 93

Robert

XLDnaute Barbatruc
Repose en paix
Re : une macro pour calculer la moyenne pondérée

Bonjour Machoucha, bonjour le forum,

Peut-être comme ça :
Code:
Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Long 'déclare la variable li (LIgne)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cc As Range 'déclare la variable cc (Cellule colonne C)
Dim cev As Range 'déclare la variable cev (CEllule Visible)
Dim q As Double 'déclare la variable q (Quantité)
Dim mo As Double 'déclare la variable mo (MOyenne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set o = Sheets("Feuil1") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière cellule éditée dl de la colonne 1 (=A) de l'onglet o
Set pl = o.Range("A2:A" & dl) 'définit la plage pl
For li = dl To 2 Step -1 'boucle 1 : inversée de la dernière à la seconde ligne
    Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
    o.Range("A1").AutoFilter field:=1, Criteria1:=o.Cells(li, 1).Value 'filtre les référence du tableau
    For Each cc In pl.Offset(0, 2).SpecialCells(xlCellTypeVisible) 'boucle 2 : sur toutes les cellules visibles de la plage pl en colonne c
        d(cc.Value) = "" 'alimente le dictionnaire d
    Next cc 'prochaine cellule de la boucle
    If d.Count > 1 Then 'condition : si le nombre de prix différents en colonne C est supérieur à 1
        q = 0 'initialise la quantité q
        mo = 0 'initialise la moyenne pondérée mo
        For Each cev In pl.SpecialCells(xlCellTypeVisible) 'boucle 3 : sur toutes les cellules visble cev de la plage pl
            q = q + CDbl(cev.Offset(0, 1).Value) 'définit la quantité q
            mo = mo + CDbl(cev.Offset(0, 1).Value) * CDbl(cev.Offset(0, 2).Value) 'définit la moyenne pondérée mo
        Next cev 'prochaine cellule visible de la boucle 3
        li = pl.SpecialCells(xlCellTypeVisible).Cells(1, 1).Row 'définit la ligne li
        'supprime les ligne après la première
        pl.SpecialCells(xlCellTypeVisible).Cells(2, 1).Resize(pl.SpecialCells(xlCellTypeVisible).Rows.Count - 1, 1).EntireRow.Delete
        o.Cells(li, 2) = q 'place la quantité en colonne B
        o.Cells(li, 3).Value = mo / q 'place la moyenne pondérée en colonne B
    End If 'fin de la condition
o.Range("A1").AutoFilter 'supprime le filtre automatique
Next li 'prochaine ligne  li de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 

Discussions similaires

Réponses
14
Affichages
618
Réponses
7
Affichages
292