تجميع بيانات من اكثر من شيت لاسماء مختلفه باستخدام قائمه منسدله

[ايهاب السيد بدوى]

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

يوجد فى شيت رقم 1 اسماء وكل اسم له مبلغ وضريبه ودمغه

وفى شيت رقم 2 يوجد اسماء من شيت رقم 1 واسماء مختلفه لا توجد فى شيت رقم 1وامام كل اسم مبلغ وضريبه ودمغه وخانه 1% 

وفى شيت رقم 3 يوجد نفس الاسماء من شيت رقم 1 و2 واسماء مختلفه 

اريد فى الشيت النهائى عند كتابه الاسم او باستخدام قائمه منسدله يتم تجميع  خانه المبلغ  وخانه الضريبه وخانه الدمغه وخانه 1% الموجود امام كل اسم  فى شيت رقم 1 و2و3 ويتم وضع المجموع امام الاسم فى الشيت النهائى فى خانه المبلغ وخانه الضريبه وخانه الدمغه وخانه 1%

واذا كان اسم الشخص موجود فى شيت رقم 1 وله مبلغ فى خانه المبلغ ولايوجد اسمه فى شيت رقم 2 واسمه موجود فى شيت رقم 3 وله مبلغ فى خانه المبلغ فبالتالى يجمع المبلغ فى شيت رقم 1 و 3

وفى ملف مرفق

ولكم جزيل الشكر

 

بيانات.rar

[سليم حاصبيا]

جرب هذا الكود
اذا لم تظهر القائمة المنسدلة (في الشيت Result) غادر الصفجة ثم عد اليها مجدداً

Ihab.xlsm

[سليم حاصبيا]

الكود يعمل مع اي عدد من الشيتات 

1-المهم وجود الشيت Result

2 _ ان تكون الييانات في نطاق واحد من كل شبت ( ابتداءٍ من الخلية  A2 ) و بدون صفوف فارغة

[ايهاب السيد بدوى]

شكرا استاذ سليم على ردك 

سؤال اخر اذا اردت ان اجعل  الكود يعمل فى حاله وجود اعمده اكتر بمعنى ان اريد ان يبحث فى حاله وجود اكثر من عمود واريد انا اجمع عن اعمده معينه فقط تكون اسماء الاعمده فيها خاضع او ضريبه كسب العمل او دمغه عاديه فقط ولا يجمع ارقام فى اعمده اخرى 

 

[سليم حاصبيا]

تفعل كما في الصورة

 

[ايهاب السيد بدوى]

شكرا استاذ سليم على ردك 

فى المرفق ده بعد اذنك  لو انا عاوز اجمع فقط الاعمده بعنوانين غير خاضع وخاضع وضريبه كسب العمل والدمغه العدايه ولمواجهه الاوبئه وصندوق الاعاقه فقط ولا يجمع باقى الاعمده 

 

Book1.xlsx

[سليم حاصبيا]

لم افهم شيئاً مما تريد

و أين الشيت Result

[ايهاب السيد بدوى]

استاذ سليم  بمعنى ان يكون فى اكتر من شيت وترتيب الاعمده مختلف وليست بنفس الترتيب فى كل الشيتات

اذا اردت مثلا فى شيت result انا اجمع مثلا الاعمده الخاصه بخانه غبر خاضع وخانه خاضع اسفل خانه الجمله والاعمده الخاصه بخانه اجمالى الاجر والاعمده الخاصه بخانه غير خاضع وبخانه خاضع اسفل خانه الاجر الاضافى والاعمده الخاصه بخانه الضريبه والاعمده الخاصه بخانه الدمغه والاعمده الخاصه بخانه جمله المستحقات

Ihab.rar

[سليم حاصبيا]

جرب هذا الماكرو (حتى لو تكرر الاسم في نفس الصفحة يقوم الماكرو بايجاده  مع تلوينه)   مثلاً   "كريم عفيفى"

Sub Data_Sum_1()
  Dim Res As Worksheet
  Dim sh As Worksheet
  Dim ro1%, ro2%, K%
  Dim F_rg As Range
  Dim Ar

Set Res = Sheets("Result")
Ar = Array(0, 0, 0, 0, 0, 0, 0, 0)

Res.Range("A3:I3").ClearContents

If Res.Cells(1, "K") = vbNullString Then Exit Sub
For Each sh In Sheets
    If sh.Name <> "Result" Then
       sh.Range("A3:J1000"). _
       Interior.ColorIndex = xlNone
        Set F_rg = sh.Range("A:A"). _
         Find(Res.Cells(1, "K"), lookat:=1)
           
           If Not F_rg Is Nothing Then
              ro1 = F_rg.Row: ro2 = ro1
              Do
                 sh.Cells(ro2, 1).Resize(, 10). _
                 Interior.ColorIndex = 35
                 
                 For K = LBound(Ar) To UBound(Ar)
                  Ar(K) = Ar(K) + Val(sh.Cells(ro2, 3).Offset(, K))
                 Next
                Set F_rg = sh.Range("A:A").FindNext(F_rg)
                ro2 = F_rg.Row
                If ro1 = ro2 Then Exit Do
              Loop
          End If
    End If
 Next sh
 
 With Res.Cells(3, 1)
 .Value = Res.Cells(1, "K")
 .Offset(, 1).Resize(, UBound(Ar) + 1) = Ar
 End With

End Sub

الملف مرفق

 

Ihab_summation.xlsm

[ايهاب السيد بدوى]

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

جمع الارقام مش مظبوط يا استاذ سليم مثلا بالنسبه لكريم عفيفى جمع الخانات غلط مثلا جمع الضريبه غلط

 

[خيماوي كووول]

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

بعد اذن اخوي العزيز .. سليم .. تم وضع معادلة ..

 

Ihab_summation.xlsm

تم تعديل ديسمبر 22, 2020 بواسطه خيماوي كووول

[سليم حاصبيا]

لا تحكم على شيء دون ان تتأكد

لا حظ  عبد الكريم سلام   

(عدد الساعات لا تتم حسابها) لانك لم تضعها في الجدول في الصفحة Result

في الصفحة الأولى :
1- من C7  الى J7      في كل خلية 1
2- من C10  الى J10    في كل خلية 1
في الصفحة الثّانية :
1- من C6  الى J6       في كل خلية 1
2- من C10  الى J10    في كل خلية 1
3- من C13  الى J13   في كل خلية 1

المحموع العام في كل حلية  5  وهذا ما تجده في الصفحة Result

Ihab_summation_1.xlsm

[سليم حاصبيا]

ممتاز

لكن الاخ بريد ان يكون عدد الصفحات غير محصور بــ 2 فقط

[ايهاب السيد بدوى]

 

ممكن عمل كود فى هذا الشيت الجديد باستخدام قائمه منسدله فى شيت result  يجمع المبالغ فى اكثر من شيت مع العلم انه ممكن ان يكون اكثر من شيت حتى شهر ديمسبر  باسماء اخرى غير الموجوده فى شيت يناير وفبراير ومارس وابريل 

Book34.rar

[سليم حاصبيا]

كنت أود عمل ذلك 

لكن حصرتك ما اقتنعت بالكود الذي كتبته لك في المشاركة السابقة

[سليم حاصبيا]

جرب هذا الملف
1- يمكن ان تختار اسم واحد أو كل الاسماء
2- الجمع يتم على الأعمدة E و F و I و J من كل صفحة (تم عمل حساب تكرار الاسم في الصفحة الواحدة)

3- يالنسبة للاسم الواحد

Sub Data_Sum_1()
  Dim Res As Worksheet
  Dim Sh As Worksheet
  Dim ro1%, ro2%, K%
  Dim F_rg As Range
  Dim Ar

Set Res = Sheets("Result")
Ar = Array(0, 0, 0, 0)

If Res.Range("A1").CurrentRegion.Rows.Count > 2 Then
    Res.Range("A1").CurrentRegion.Offset(2). _
    Resize(Res.Range("A1").CurrentRegion.Rows.Count - 2).Clear
  End If

If Res.Cells(2, "H") = vbNullString Then Exit Sub
For Each Sh In Sheets
    If Sh.Name <> "Result" Then
       Sh.Range("A3:J1000"). _
       Interior.ColorIndex = xlNone
        Set F_rg = Sh.Range("B:B"). _
         Find(Res.Cells(2, "H"), lookat:=1)
           
           If Not F_rg Is Nothing Then
              ro1 = F_rg.Row: ro2 = ro1
              Do
                 Sh.Cells(ro2, 1).Resize(, 10). _
                 Interior.ColorIndex = 35
                 
                      Ar(0) = Ar(0) + Val(Sh.Cells(ro2, 5))
                      Ar(1) = Ar(1) + Val(Sh.Cells(ro2, 6))
                      Ar(2) = Ar(2) + Val(Sh.Cells(ro2, 9))
                      Ar(3) = Ar(3) + Val(Sh.Cells(ro2, 10))
                
                Set F_rg = Sh.Range("B:B").FindNext(F_rg)
                ro2 = F_rg.Row
                If ro1 = ro2 Then Exit Do
              Loop
          End If
    End If
 Next Sh

 With Res.Cells(3, 1)
 .Value = 1
 .Offset(, 1) = Res.Cells(2, "H")
 .Offset(, 2).Resize(, UBound(Ar) + 1) = Ar
    With .Resize(, UBound(Ar) + 3)
       .Borders.LineStyle = 1
       .Font.Size = 14
       .Font.Bold = True
       .InsertIndent 1
       .Interior.ColorIndex = 35
     End With
 End With

End Sub

بالنسبة لكل الاسماء

Sub Data_Sum_ALL()
  Dim Res As Worksheet
  Dim Sh As Worksheet
  Dim ro1%, ro2%, K%
  Dim F_rg As Range
  Dim Ar
  Dim OBJ As Object, ky
  Dim m%, t%
      
      Set OBJ = CreateObject("Scripting.Dictionary")
      Set Res = Sheets("Result")
  If Res.Range("A1").CurrentRegion.Rows.Count > 2 Then
    Res.Range("A1").CurrentRegion.Offset(2). _
    Resize(Res.Range("A1").CurrentRegion.Rows.Count - 2).Clear
  End If
      For Each Sh In Sheets
       If Sh.Name <> "Result" Then
         m = 3
         Do Until Sh.Cells(m, 2) = vbNullString
          OBJ(Sh.Cells(m, 2).Value) = vbNullString
          m = m + 1
         Loop
       End If
      Next Sh
 Ar = Array(0, 0, 0, 0)
 If OBJ.Count Then
 t = 3
For Each ky In OBJ.keys
      For Each Sh In Sheets
            If Sh.Name <> "Result" Then
                Set F_rg = Sh.Range("B:B").Find(ky, lookat:=1)
                If Not F_rg Is Nothing Then
                    '+++++++++++++++++++++++
                    ro1 = F_rg.Row: ro2 = ro1
                    Do
                      Ar(0) = Ar(0) + Val(Sh.Cells(ro2, 5))
                      Ar(1) = Ar(1) + Val(Sh.Cells(ro2, 6))
                      Ar(2) = Ar(2) + Val(Sh.Cells(ro2, 9))
                      Ar(3) = Ar(3) + Val(Sh.Cells(ro2, 10))
                    
                      Set F_rg = Sh.Range("B:B").FindNext(F_rg)
                      ro2 = F_rg.Row
                      If ro1 = ro2 Then Exit Do
                    Loop
                
                '++++++++++++++++++++++++++
                
                End If 'F_rg
            End If 'Sh
            
      Next Sh
            Res.Cells(t, 2) = ky
            Res.Cells(t, 3).Resize(, UBound(Ar) + 1) = Ar
            Ar = Array(0, 0, 0, 0)
            t = t + 1
 Next ky
    With Res.Range("A3").Resize(t - 3, 6)
    .Columns(1).Value = _
     Evaluate("Row(1:" & t - 3 & ")")
    .Borders.LineStyle = 1
    .Font.Size = 14
    .Font.Bold = True
    .InsertIndent 1
    .Interior.ColorIndex = 35
    End With
 End If 'dic.count
End Sub

الملف مرفق

Ihab_ALL.xlsm

[سليم حاصبيا]

نم التعديل على الكود لتظهر أسماء الشيتات حيث الاسم موجود

 

Ihab_ALL_new.xlsm

[ايهاب السيد بدوى]

شكرا يااستاذ سليم 

بارك الله فيك وجزاك الله خيرا 

سؤال اخير لو عاوز اجمع اعمده اخرى غير  E و F و I و J ازاى اضيفها فى الكود او كيفيه استبدال اعمده E و F و I و J باعمده اخرى 

[سليم حاصبيا]

لاحظ هذه الصورة
1- في المريع الأحمر تضع اصفاراً حسب عدد الأعمدة المطلوبة ( في الصورة 4 أعمدة)
2- في المربع الأزرق تضع ارقام هذه الأعمدة (E=5 / F=6 / H=8 ) وهكذا

[خيماوي كووول]

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

اضافة .. معادلة بغض النظر عن عدد الاوراق .. ومكان الاعمده المطلوب الحساب منها ..  المهم هو اسماء الاعمدة ..

sumsalarymultisheets.xlsm

[ايهاب السيد بدوى]

شكرا يا استاذ سليم 

بارك الله فيك وجزاك الله خيرا