جمع ارقام في خلايا محدده في شيتات مختلفة على حسب اسم الصنف

[محمد عبد الناصر]

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

في الملف المرفق ملف يوجد به عدة شيتات باسماء مختلفة 

اريد في شيت "بيان الارباح" في عمود "سعر البيع" ان يقوم بجمع اسم الصنف المحدد في العمود B بدون ان يجمع اسم الصنف من شيت( المخزن و المدخلات و الفاتورة و sheet1 )
بحيث اذا قمت بفتح شيت لعميل جديد يقوم بجمع الاصناف المباعه لهذا العميل والعملاء القديمة 
يجمع فقط  كل الصنف المحدد من العملاء فقط

الملف المرفق موضح المطلوب
اعتذر لضغط الملف لكبر مساحته

Mohamed Nasser.rar

[محمد يوسف ابو يوسف]

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

اخي

من قضلك قم بتوضيح اكثر...

يمكنك كتابة المراد تنفيزة ولو بطريقة يدوية داخل الملف بشرح مبسط وواضح لكي  يتفهم المطلوب لدا الجميع

مثلاً .... اريد جمع عمود b....او اريد جمع ربح كل فاتورة عميل علي حدة...وهكذا
 

[محمد عبد الناصر]

اعتذر اخي الكريم سوف اقوم بالتعديل

تعديل توضيح اكثر

في الملف المرفق شيت باسم "بيان الارباح" يوجد به العمود B5 اصناف اريد كود ان يقوم بجمع كل الشيتات من العمود G5 على حسب كل صنف وان يترك هذه الشيتات ولا يبحث فيها عن اي بيانات ( المخزن و المدخلات و الفاتورة و sheet1 
فقط اريد جمع سعر بيع كل صنف على حده عند تشغيل الكود

Mohamed Nasser.rar

[محمد عبد الناصر]

اعتذر منك اريد فقط تجميع كل صنف تم بيعه من شيتات العملاء فقط

[محي الدين ابو البشر]

عليكم السلام

عسى ولعل يكون المطلوب

Sub test()
Dim a, x, w
Dim i&
Dim sht As Worksheet
x = Array("المخزن", "المدخلات", "الفاتورة", "Sheet1", "بيان الأرباح")
Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
With CreateObject("scripting.dictionary")
        For Each sht In ActiveWorkbook.Worksheets
             If IsError(Application.Match(sht.Name, x, 0)) Then
             a = sht.Cells(8, 1).Resize(sht.Cells(Rows.Count, 1).End(xlUp).Row - 7, 7)
                For i = 1 To UBound(a)
                    If Not .exists(a(i, 2)) Then
                 .Add a(i, 2), Array(a(i, 4), a(i, 3) * a(i, 4), a(i, 7))
            Else
         w = .Item(a(i, 2))
        w(0) = w(0) + a(i, 4): w(1) = w(1) + a(i, 3) * a(i, 4): w(2) = w(2) + a(i, 7)
        .Item(a(i, 2)) = w
        End If
            Next
        End If
    Next
For i = 5 To Range(Cells(5, 2), Cells(5, 2).End(xlDown)).Count
       If Cells(i, 2) = "" Then Exit Sub
    If Not .exists(Cells(i, 2)) Then Cells(i, 3).Resize(, 3) = .Item(Cells(i, 2).Value)
    Next
End With
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

 

بيان الأرباح.rar

تم تعديل فبراير 21, 2023 بواسطه محي الدين ابو البشر

[محمد عبد الناصر]

28 دقائق مضت, محي الدين ابو البشر said:

عليكم السلام

عسى ولعل يكون المطلوب

Sub test()
Dim a, x, w
Dim i&
Dim sht As Worksheet
x = Array("المخزن", "المدخلات", "الفاتورة", "Sheet1", "بيان الأرباح")
Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
With CreateObject("scripting.dictionary")
        For Each sht In ActiveWorkbook.Worksheets
             If IsError(Application.Match(sht.Name, x, 0)) Then
             a = sht.Cells(8, 1).Resize(sht.Cells(Rows.Count, 1).End(xlUp).Row - 7, 7)
                For i = 1 To UBound(a)
                    If Not .exists(a(i, 2)) Then
                 .Add a(i, 2), Array(a(i, 4), a(i, 3) * a(i, 4), a(i, 7))
            Else
         w = .Item(a(i, 2))
        w(0) = w(0) + a(i, 4): w(1) = w(1) + a(i, 3) * a(i, 4): w(2) = w(2) + a(i, 7)
        .Item(a(i, 2)) = w
        End If
            Next
        End If
    Next
For i = 5 To Range(Cells(5, 2), Cells(5, 2).End(xlDown)).Count
       If Cells(i, 2) = "" Then Exit Sub
    If Not .exists(Cells(i, 2)) Then Cells(i, 3).Resize(, 3) = .Item(Cells(i, 2).Value)
    Next
End With
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

 

بيان الأرباح.rar 884.48 kB · 5 downloads

ماشاء الله وبارك الله عز وجل في علمك اسال الله ان يرزقك الخير وان يجعله في موازين حسناتك

[محي الدين ابو البشر]

بارك الله