استدعاء بيانات حسب شروط بالمعادلات

[مصطفى محمود مصطفى]

السلام عليكم

الاخوة الكرام وفقكم الله

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

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

والافضل بالمعادلات كون القاعدة يمكن ان تتغير فيها مسميات الاعمدة او ارقام الاعمدة 

شاكرين تعاونكم معنا ولكم تحياتي

استدعاءبشروط.rar

[shreif mohamed]

وعليكم السلام

تفضل اخي ، واعلم ان الماكرو يعمل علي التنسيق الشرطي المسبق واسماء الشيتات كما هو مرفق 

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

 

استدعاء بشروط.xlsm

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

بعد اذن اخي شريغ هذا الكود (يمكن ان يكون اسرع قليلاُ)

Option Explicit
Sub Filter_For_Me()
 With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
 End With
 On Error GoTo Exit_sub
Dim i%
Dim t%
Dim arr(): arr = Array("م", "غ", "<50", "صفر")
Dim My_Rg As Range
Dim FinaL_row%: FinaL_row = Sheets("data").Cells(Rows.Count, 2).End(3).Row
 Set My_Rg = Sheets("data").Range("b2:M" & FinaL_row)
  For i = 2 To Sheets.Count
     With Sheets(i)
        .Range("a2:M1000").Clear
        .Range("Xfd1") = .Name
        .Range("xfd2").Resize(4, 1) = Application.Transpose(arr)
         My_Rg.AdvancedFilter Action:=2, _
           CriteriaRange:=.Range("xfd1:xfd5"), _
           CopyToRange:=.Range("a2"), Unique:=False
        .Range("a1").CurrentRegion.Columns.AutoFit
        .Range("xfd1:xfd5").Clear
    
          For t = 12 To 5 Step -1
           If .Cells(2, t) <> .Name Then .Cells(2, t).EntireColumn.Delete
          Next t
     End With
   Next i
Exit_sub:
     With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
     End With
   Erase arr
End Sub

الملف مرفق

 

استدعاءبشروط Salim1.xlsm

[shreif mohamed]

  في 3‏/4‏/2018 at 10:04, سليم حاصبيا said:

بعد اذن اخي شريغ هذا الكود (يمكن ان يكون اسرع قليلاُ)

الملف مرفق

 

استدعاءبشروط Salim1.xlsmFetching info...

Expand  

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

اشكرك  احي سليم علي إثراء الموضوع وطرح حلول مفيدة 

[مصطفى محمود مصطفى]

الاستاذ العزيز shreif mohamed جزاكم الله خيرا

عمل رائع جعله الله في ميزان حسناتكم

تحياتي ووافر احترامي

الاستاذ الكبير سليم حاصبيا جزاكم الله خيرا

كود دقيق وممتاز جعله الله في ميزان حسناتكم

تحياتي ووافر احترامي

تم تعديل أبريل 3, 2018 بواسطه مصطفى محمود مصطفى

[محمد لؤي]

السلام عليكم

ممكن اضافة فقرة

انشاء الشيتات تلقائيا حسب اسم المادة

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

  في 4‏/4‏/2018 at 05:20, محمد لؤي said:

السلام عليكم

ممكن اضافة فقرة

انشاء الشيتات تلقائيا حسب اسم المادة

Expand  

جرب هذا الملف(لعله المطلوب)

 

ADD_SHEETS.xlsm

[محمد لؤي]

السلام عليكم - جزيت خيرا - هو المطلوب 

تمام الترحيل حسب الاسم

ممكن بدل الاسم يكون التاريخ

أي الترحيل حسب التاريخ

 

 

تم تعديل أبريل 4, 2018 بواسطه محمد لؤي

[مصطفى محمود مصطفى]

الاستاذ الفاضل  سليم حاصبيا جزاكم الله خيرا

عمل رائع جعله الله في ميزان حسناتكم

انا غيرت  في الكود لكي يعمل بالصف الثاني كمافي ملفي الاول  والحمد لله ولو به اهتزار لكن تم فتح صفحات استنادا الى اسماء المواد 

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

هل يمكن التعديل على ذلك ليصبح اكثر مرونة عند تغيير المواد

تحياتي ووافر احترامي

 

فتح اوراق جديدة واستدعاءبشروط Salim1 (1).xlsm

[مصطفى محمود مصطفى]

الاستاذ الفاضل  سليم حاصبيا جزاكم الله خيرا

الاساتذة الكرام حفظكم الله

ان امكن ارجو التعديل على الكود الرائع للاخ سليم جزاه الله خيرا

اولا ان يبدا بترحيل البيانات للاوراق ابتداءا من العمود B  بدلا من العمود A الذي يعمل عليه الكود الان

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

للعلم انا غيرت به لكن التغيير لم يفلح حيث يترك ترحيل الجنس ويرحل الوطنية مع كل المواد كما في المرفق

تحياتي ووافر احترامي

 

استدعاءبشروط تعديلSalim1.rarFetching info...

تم تعديل أبريل 6, 2018 بواسطه مصطفى محمود مصطفى
اضافة شرط اخر