معادلة جلب البيانات من عدة صفحات بناءاً على اسم الصفحة

[مهند محسن]

السلام عليكم اساتذتى الأحباء 

ارجو التكرم على مساعدتى في جلب المبالغ امام كل شخص معين من عدة صفحات وذلك من أعمدة مختلفة عن طريق اسم الصفحة الموجود في رأس الجدول 

فقد قمت بعمل معادلة Sumif ,ولكنى اريد معادلة أخرى حيث ان الصفحات سوف تتعدى 30 صفحة ومن الصعب القيام بهذا يدويا مع هذه المعادلة لأنى سأضطر للدخول لكل صفحة على حده لعمل هذه المعادلة فربما يكون هناك أخطاء عند اختيار صفحة خطأ مثلا

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

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

كما ياريت احد الأساتذة يساعدنى في حل هذا التنسيق الذى يظهر بالصورة المرفوعة فهو بدوره يقوم بعمل بطء وثقل كبير في الملف عند العمل عليه

 

 

Total.xlsx

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

جرب هذا الماكرو

تم التعديل على  الملف قليلاً لتصغير حجمه

Option Explicit
Sub Get_data()
If ActiveSheet.Name <> "Total" Then Exit Sub

Dim last_row%
Dim k%, r
Dim mY_sh As Worksheet
last_row = Sheets("Total").Cells(Rows.Count, 2).End(3).Row
Sheets("Total").Range("c3", Range("c4").End(4)).Resize(, 3).ClearContents
Dim i%: i = 3
Dim x$
Dim col%
Do Until Sheets("Total").Range("b" & i) = vbNullString
 For k = 3 To 5
  x = Sheets("Total").Cells(2, k)
    Set mY_sh = Sheets(x)
     r = mY_sh.Range("b:b").Find(Sheets("Total").Range("b" & i)).Row

Select Case x
    Case "Excursion": col = 8
    Case "Shopping": col = 4
    Case "Bonus": col = 3
 End Select
      Sheets("Total").Cells(i, k) = mY_sh.Cells(r, col)
      Next

i = i + 1
Loop
Sheets("Total").Range("c3", Range("c4") _
.End(4)).Resize(, 4).NumberFormat = "0.00"
End Sub

الملف مرفق

 

Total Salim.xlsm

[مهند محسن]

ابداع أستاذ سليم كود رائع وهو المطلوب بالفعل جزاك الله كل خير وغفر الله لك ووسع الله في رزقك

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

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

هل هناك حل بالمعادلات يقوم بنفس النتيجة ,كما اننى اتأسف واعتذر لحضرتك على تعبك معى -هل هناك حل لإزالة التنسيقات التي تظهر بالصورة

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

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

اذا زاد عدد الصفحات تقوم بالتعديل في هذا القسم من الكود مع مراعاة ان تأخذ  الــ  K  عدداً جديداً من 3 الى

3 + عدد الصفحات -1

في مثلنا عدد الصفحات (بدون الــ Total ) يساوي 3  ====> عدد الصفحات -1=2 ====> 

3 + عدد الصفحات -1=5           ====>    (اخذنا الــ K  من 3 الى 5)

Select Case x
    Case "Excursion": col = 8
    Case "Shopping": col = 4
    Case "Bonus": col = 3
 End Select

 

[مهند محسن]

جزاك الله كل خير أستاذ سليم وزادك الله من فضله

 

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

بالنسبة للسؤال الثاني (حل لإزالة التنسيقات)

هذا الكود

Option Explicit
Sub del_shapes()
Dim x As Shape
For Each x In ActiveSheet.Shapes
x.Delete
Next
End Sub

 

[مهند محسن]

بارك الله فيك استاذى الكريم وجزاك الله كل خير-واكثر الله من أمثالك وزادك الله من فضله ووسع الله في رزقك

وشكرا لك استاذى الكريم على استجابتك ولكنى

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

 وذلك كما بالصورة

 

تم تعديل يونيو 23, 2019 بواسطه مهند محسن

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

بعد تنفيذ الماكرو الذي ينظف لك كل شيء اسمه Shapes (مرة واحدة فقط) تستطيع انشاء بوتن جديد 

[مهند محسن]

أحسنت استاذى الكريم تم المطلوب على اكمل وجه بفضل الله ثم بفضل حضرتك وابداعاتك استاذى الكريم

جزاك الله كل خير واعتذر واتأسف دائما لإزعاج حضرتك

فمن شيم الرجال العطاء دائما -بارك الله فيك ووسع الله في رزقك واكرمك الله كما اكرمتنى وفرج عنك كربات يوم القيامة كما فرجت علينا كرب الدنيا

[Ali Mohamed Ali]

كود ممتاز استاذ سليم

بعد اذن حضرتك ولإثراء الموضوع هناك حل أخر بالمعادلات

فى العمود C يمكنك استخدام هذه المعادلة مع التغيير المطلوب فى كل معادلة

 

=SUMPRODUCT(SUMIF(INDIRECT("'"&C$2&"'!"&"B2:B1000"),$B3,INDIRECT("'"&C$2&"'!"&"H2:H1000")))

 

Total.xlsm