اذهب الي المحتوي
أوفيسنا

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


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

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

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

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

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

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

وفى ملف مرفق

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

 

بيانات.rar

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

 

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

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

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

 

Book1.xlsx

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

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

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

Ihab.rar

  • Like 1
رابط هذا التعليق
شارك

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

(عدد الساعات لا تتم حسابها) لانك لم تضعها في الجدول في الصفحة 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

Screenshot_1.png

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

 

ممكن عمل كود فى هذا الشيت الجديد باستخدام قائمه منسدله فى شيت 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

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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

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

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

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

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

Ihab.png

  • Like 1
رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information