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

ايهاب السيد بدوى · ديسمبر 9, 2020

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

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

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

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

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

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

وفى ملف مرفق

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

بيانات.rar

**سليم حاصبيا** · ديسمبر 9, 2020

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

Ihab.xlsm

**سليم حاصبيا** · ديسمبر 10, 2020

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

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

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

ايهاب السيد بدوى · ديسمبر 15, 2020

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

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

**سليم حاصبيا** · ديسمبر 15, 2020

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

ايهاب السيد بدوى · ديسمبر 15, 2020

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

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

Book1.xlsx

**سليم حاصبيا** · ديسمبر 15, 2020

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

و أين الشيت Result

ايهاب السيد بدوى · ديسمبر 21, 2020

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

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

Ihab.rar

**سليم حاصبيا** · ديسمبر 21, 2020

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

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

ايهاب السيد بدوى · ديسمبر 22, 2020

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

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

**خيماوي كووول** · ديسمبر 22, 2020

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

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

Ihab_summation.xlsm

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

**سليم حاصبيا** · ديسمبر 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

**سليم حاصبيا** · ديسمبر 22, 2020

ممتاز

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

ايهاب السيد بدوى · ديسمبر 22, 2020

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

Book34.rar

**سليم حاصبيا** · ديسمبر 22, 2020

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

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

**سليم حاصبيا** · ديسمبر 22, 2020

جرب هذا الملف
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

**سليم حاصبيا** · ديسمبر 22, 2020

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

Ihab_ALL_new.xlsm

ايهاب السيد بدوى · ديسمبر 23, 2020

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

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

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

**سليم حاصبيا** · ديسمبر 23, 2020

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

**خيماوي كووول** · ديسمبر 23, 2020

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

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

sumsalarymultisheets.xlsm

ايهاب السيد بدوى · ديسمبر 23, 2020

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

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

تسجيل الدخول

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

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information