XL 2010 formule coût moyen pondérée stock finale

[AMINEKET]

Bonjour,
J'ai un problème au niveau du formule out moyen pondérée stock finale (colonne jaune)

merci de m’aider pour trouver le formule convenable

 

[soan]

Bonjour AMINEKET,

bienvenue sur le site XLD !

feuille "FS-MVT" : note que pour les colonnes K à V, seules 3 ne sont pas vides : N ; O ; Q ; fais Ctrl e ➯ travail effectué ! à toi de vérifier tous les résultats ! ​

Option Explicit: Option Compare Text

Sub Essai()
  If ActiveSheet.Name <> "FS-MVT" Then Exit Sub
  Dim n1&: n1 = Cells(Rows.Count, 2).End(3).Row: If n1 < 5 Then Exit Sub
  Dim T, cel As Range, ref$, QM%, QT%, QA#, PU#, MM#, MT#
  Dim mvt$, n2&, n3&, i&, j&, k%: n3 = n1 - 4: Application.ScreenUpdating = 0
  If n1 > 4 Then Range("K5:M" & n1 & ", P5:P" & n1 & ", R5:V" & n1) = Empty
  ReDim T(n1)
  Do
    'recherche d'une 1ère référence
    ref = "": i = 5
    Do
      With Cells(i, 2)
        If ref = "" And T(i) = 0 And .Offset(, 5) = "Stock Initial" Then
          ref = .Value: QT = 0: QA = 0: MT = 0
          Set cel = Worksheets("INVENTAIRE").Columns(5).Find(ref, , -4163, 1, 1)
          If Not cel Is Nothing Then
            QT = cel.Offset(, 3): PU = cel.Offset(, 4)
            If QT > 0 Then
              .Offset(, 9) = QT: .Offset(, 18) = QT: QA = QT
              If PU > 0 Then
                .Offset(, 10) = PU: .Offset(, 19) = PU: MT = QT * PU
                .Offset(, 11) = MT: .Offset(, 20) = MT
              End If
            End If
          End If
          T(i) = 1: n2 = n2 + 1: j = i + 1: Exit Do
        Else
          i = i + 1
        End If
      End With
    Loop Until i > n1
    'traitement de toutes les lignes de la 1ère référence ci-dessus
    For i = j To n1
      With Cells(i, 2)
        If ref <> "" And .Value = ref And T(i) = 0 Then
          mvt = .Offset(, 5): k = -(mvt = "Entrée") - 2 * (mvt = "Sortie")
          If k = 1 Then
            QM = .Offset(, 12)
            If QM > 0 Then
              QT = QT + QM: MM = QM * .Offset(, 13): .Offset(, 14) = MM: MT = MT + MM
              QA = QA + QM: If QA <> 0 Then PU = Round(MT / QA, 5)
            End If
          ElseIf k = 2 Then
            QM = .Offset(, 15)
            If QM <> 0 Then
              QT = QT - QM: MM = QM * PU: .Offset(, 16) = PU: .Offset(, 17) = MM: MT = MT - MM
            End If
          End If
          If k > 0 Then
            .Offset(, 18) = QT: .Offset(, 20) = MT: If PU > 0 Then .Offset(, 19) = PU
            T(i) = 1: n2 = n2 + 1
          End If
        End If
      End With
    Next i
  Loop Until n2 = n3
End Sub

soan

 

[soan]

@AMINEKET

Lis d'abord mon post précédent.

comme tu as Excel 2010, j'ai converti le fichier .xls (627 Ko)
en fichier .xlsm (250 Ko) ; gain : 377 Ko ➯ -60,13 %

utilisation & code VBA : identiques.

soan