عمل متوسط شهرى لعدد من المنتجات

[q8q8q]

يرجى المساعدة باستخراج تقرير شهرى ( لكل السنة) لمتوسط قيمة منتجات على ان يكون الشكل كالتالى:

الصف يناير فبراير الى اخر شهر

العامود يتكون من مجموعة من المنتجات 

 

جزاكم الله خيرا

شهر 12022.zip

[أ / محمد صالح]

يمكنك تجربة استخدام هذه المعادلة في الخلية D5

=SUMIFS(table1!$A:$A,table1!$C:$C,$C5,table1!$D:$D,">="&DATE(2022,D$4,1),table1!$D:$D,"<="&EOMONTH(DATE(2022,D$4,1),0))

بالتوفيق

[q8q8q]

الاستاذ محمد صالح

احتاج متوسط السعر (average) وليس اجمالى(sum) السعر

شكرا على جهودك

[عبدالله بشير عبدالله]

السلام عليكم ورحمة الله وبركاته 

يمكن بواسطة معادلة   

=IFERROR(AVERAGEIFS(table1!$A:$A; table1!$C:$C; $C5; table1!$E:$E; D$4);"")

او كود يفوم بجلب الاصناف مع متوسط كل صنف

Sub حساب_المتوسط_و_جلب_الاصناف()
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim lastRowIn As Long
    Dim dataArr As Variant
    Dim i As Long
    Dim prod As String, price As Double
    Dim dt As Variant, mon As Long
    Dim sums As Object, counts As Object, uniqueProds As Object
    Dim key As String
    Dim prodList As Variant
    Dim r As Long, c As Long
    Dim lastRowOut As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set wsIn = Sheets("table1")
    Set wsOut = Sheets("sheet1")
    Set sums = CreateObject("Scripting.Dictionary")
    Set counts = CreateObject("Scripting.Dictionary")
    Set uniqueProds = CreateObject("Scripting.Dictionary")

    lastRowIn = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
    If lastRowIn < 2 Then Exit Sub
    dataArr = wsIn.Range("A2:D" & lastRowIn).Value

    For i = 1 To UBound(dataArr, 1)
        prod = CStr(dataArr(i, 3))
        dt = dataArr(i, 4)
        If Len(prod) > 0 And IsDate(dt) Then
            mon = Month(dt)
            price = dataArr(i, 1)
            key = prod & "_" & mon
            If Not sums.Exists(key) Then
                sums(key) = 0
                counts(key) = 0
            End If
            sums(key) = sums(key) + price
            counts(key) = counts(key) + 1

            If Not uniqueProds.Exists(prod) Then
                uniqueProds(prod) = True
            End If
        End If
    Next i

    wsOut.Range("C5:C10000").ClearContents
    prodList = uniqueProds.Keys
    For i = 0 To UBound(prodList)
        wsOut.Cells(5 + i, "C").Value = prodList(i)
    Next i

    lastRowOut = wsOut.Cells(wsOut.Rows.Count, "C").End(xlUp).Row
    For r = 5 To lastRowOut
        prod = wsOut.Cells(r, "C").Value
        For c = 4 To 15
            mon = wsOut.Cells(4, c).Value
            key = prod & "_" & mon
            If sums.Exists(key) Then
                wsOut.Cells(r, c).Value = sums(key) / counts(key)
            Else
                wsOut.Cells(r, c).ClearContents
            End If
        Next c
    Next r

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

تحيانى لك ولمعلمنا الفاضل أ / محمد صالح

متوسط الاصناف كود.xlsb

متوسط الاصناف معادلة.xlsx

 

[q8q8q]

جزاكم الله خيرا جميعا