لماذا لايعمل هذا الكود

[ناصر سعيد]

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

لماذ لايعمل هذا الكود الموجود بالمرفق

كود فلتره.rar

من قضلكم

[ياسر خليل أبو البراء]

أخي الكريم ناصر سعيد

قم باستبدال الجزء الذي يحدث فيه الخطأ بهذا الكود

With Sheet1
    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
    .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9:AF9"), Unique:=True
End With

بالنسبة لنطاق الشرط ... اجعله في ورقة العمل المسماة "نتيجة 4 ترم ثاني" واكتب في الخلية A1 كلمة "التقدير" ، وفي الخلية A2 اكتب كلمة "ضعيف"

 

[ناصر سعيد]

استاذ ياسر جزاك الله كل خير وبعد:

مش عارف اظبطها وهذا هو الملف بعد اضافة الجزء الذي تفضلت بادراجه بالمنتدى

كود فلتره 6.rar

[ياسر خليل أبو البراء]

جرب الكود مرة أخرى بهذا الشكل مع تغيير طفيف جداً

With Sheet1
    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
    .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True
End With

 

 

[ناصر سعيد]

جزاك الله كل خير...

لاتعمل اخي الكريم

[ياسر خليل أبو البراء]

3 ساعات مضت, ناصر سعيد said:

جزاك الله كل خير...

لاتعمل اخي الكريم

تعمل عندي

جرب الملف التالي ..

 

كود فلتره 6.rar

[ناصر سعيد]

اخي الكريم

جزاك الله خيرا

تعمل مره واحده وبعدها حاول تمسح  بيانات الشيت التاني عشان تشغل الكود مره... لن يعمل 

حاول تغير  في حالة الطالب تجغلها ضغيف وجيد وممتاز ونظبط الكود .. لن يعمل

[ياسر خليل أبو البراء]

ربما لا يوجد بيانات للجيد أو الممتاز ..ضع بعض البيانات الوهمية وضع بعض التقديرات (جيد / ممتاز) وجرب مرة أخرى

[ناصر سعيد]

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

لن يعمل

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

[ياسر خليل أبو البراء]

بصراحة الموضوع محير ولا أجد تفسير لما يحدث ..

لما لا تجرب طريقة أخرى غير الفلترة المتقدمة ..؟!

 

[ناصر سعيد]

للرفع

[ياسر خليل أبو البراء]

18 ساعات مضت, ياسر خليل أبو البراء said:

بصراحة الموضوع محير ولا أجد تفسير لما يحدث ..

لما لا تجرب طريقة أخرى غير الفلترة المتقدمة ..؟!

 

أقل شيء أن تجيب على اقتراحي أخي العزيز ناصر .. اقترحت عليك لما لا تجرب طرق أخرى!!

[ناصر سعيد]

اشكرك اخي الكريم ياسر .. وجزاك الله خيرا وبعد

مايهمني هو الاستدعاء للدور التاني بسرعه في وجود برنامج مليء بالاكواد .. وموافق  على اي فكره تؤدي للغرض

 

[ناصر سعيد]

للرفع

 

[ناصر سعيد]

في ٢٨‏/٥‏/٢٠١٦ at 07:44, ناصر سعيد said:

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

لماذ لايعمل هذا الكود الموجود بالمرفق

كود فلتره.rar

من قضلكم

لماذ لايعمل هذا الكود الموجود بالمرفق

[omar elhosseini]

الاخ ناصر سعيد

1. في حالة التقيدير  ( ضعيف ) الكود يعمل مرة ثانيه وعاشرة
2. اما فى حالة التقديرات ( الاخري ) لن يعمل فهذا طبيعي  لأنها غير موجوده  ( يجب ان تعرف هذا  )
3. وقد قمت بتغير بعض التقيرات وهى تعمل مرة ثانيه وعاشرة

 

انظر الصورة

 

 

 

 

 

 

لقد قمت بالتغير على اول اربع  اسماء فقط

تم تعديل يونيو 3, 2016 بواسطه عمر الحسيني

[ناصر سعيد]

الغملاق عمر الحسيني

جزاك الله كل خير وبعد

هل تقصد انك تعاملت مع الملف المرفق في المشاركه الاولى الموجود بها هذا الكود

Sub kh_Filter()
Dim LR As Long
With Sheet1
    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
    .Range("AD6:BH" & LR).AdvancedFilter xlFilterCopy, Range("aa1:aa2"), Range("c9:AF9")
End With
Range("a3").Select
LR = Cells(Rows.Count, "AF").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address
End Sub

هذا هو الكود الذي اقصده وارجو بارك الله فيك شرحه

[ناصر سعيد]

15 ساعات مضت, ناصر سعيد said:

.Range("AD6:BH" & LR).AdvancedFilter xlFilterCopy, Range("aa1:aa2"), Range("c9:AF9")

خاصه هذا الجزء الذي اريد فهمه  جزاكم الله خيرا

[ناصر سعيد]

اين الاحبه

[omar elhosseini]

الاخ ناصر سعيد

نعم تعاملت ملف  الاخ ياسر خليل أبو البراء

وسأشرح الكود

هذا السطر هو كود الفلتره المتقدمة  ( التصفية المتقدمة )

.Range("AD6:BH" & LR)

لتحديد مدي قاعدة البيانات

xlFilterCopy

وهي تحدد النسخخ الي مدي محدد وهو الذي يأتي بعدها ( وممكن يكون النسخ في نفس مكان قاعدة البيانات مثل التصفيه التلقائية

ويمكنك تجربة  التصفية المتقدمة

من قائمة بيانات

ثم تصفية

ثم تتصصفية متقدمة

وعند اجادة استخددامها من القوائم يمكنك تسجيل الماكرو لينتج لك الكود المطلب

 

 

[سمير نجار]

 اخي الكريم ناصر

يظهر عندي خطأ عند الجزء

.Range("AD6:BH" & LR).AdvancedFilter xlFilterCopy, Range("aa1:aa2"), Range("c9:AF9")

 

هل يمكن ارفاق الملف النهائي

 

 

تم تعديل يونيو 5, 2016 بواسطه سمير نجار

[ناصر سعيد]

العملاق عمر الحسيني

كل عام وحضرتك طيب .. وبعد

ارجو ارفاق الملف الذي يعمل معك .. من فضلك

[omar elhosseini]

الاخ ناصر سعيد

تخيل اني انخدعت

فلم انظر الي عمود التقدير

كلامك صحيح لا يعمل الا مره واحده

اسف اخي

سأحاول اجد حل له

تحياتي

[omar elhosseini]

الاخ ناصر سعيد

لقدروفقن الله وعرفت المشكله

وهي مسح منطقة الاخراج قبل الفلتره

فيكون الكود كالتالي

تم اضافة كومبوبكس لأختيار التقدير

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

 

Sub kh_Filter()
'
Dim LR As Long

With Sheet2
    .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents
End With

With Sheet1
    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
    .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True
End With

Range("a3").Select
LR = Cells(Rows.Count, "AF").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address
'
End Sub
 

انظر المرفقات

 

كود فلتره 9.rar

مع حبي وتقديري

 

 

 

تم تعديل يونيو 5, 2016 بواسطه عمر الحسيني

[علي فاهم]

شاء ربنا ان اكون اول من يرد على العملاق الكبير عمر الحسيني

يجزيك الله كل خير تمام التمام .. كمل جميلك واشرحه