فرز قائمة

[Ahmed Elbhiry]

مطلوب فرز الورقة المرسلة (ناجح وراسب ومحول مهنى )

مطلوب فرز قائمة لهذه الورقة.zip

[الـعيدروس]

السلام عليكم

نتيجة الفرز اين تريدها ان تكون

في نفس الشيت ام في شيت اخر

[Ahmed Elbhiry]

اسف لتاخرى بالرد النت كان قاطع عندى والانشغال بالانتخابات (مطلوب الفرز فى نفس الصفحة او صفحة مجاورة )

وشكرا لحضرتك على الرد واسف للتأخير

[الـعيدروس]

ماهو عمود الفرز

============================

حيث /ان الرفم (1) يساوى ناجح "إقتباس"

============================

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

[Ahmed Elbhiry]

انا شارح بالملف المرسل كل اللى انا عايزه عموما العمود (ap)

[الـعيدروس]

السلام عليكم

الاخ الفاضل احمد

السموحه منك السهر باين عليه مؤثر فينا

تفضل هذا الكود

Sub ALIDROOS_JC()

Dim ish As Worksheet

Dim SRH_ALI As Range

Application.ScreenUpdating = False

Range(Cells(6, 1), Cells(Rows.Count, 42)).ClearContents

ALI = [A2].Value

If ALI = "" Then MsgBox "سطر فارغ": [A2].Select: Exit Sub

With ورقة18.Range("AP8:AP25000")

Set SRH_ALI = .Find(ALI, LookIn:=xlValues)

If Not SRH_ALI Is Nothing Then

firstAddress = SRH_ALI.Address

Do

SRH_ALI.Offset(0, -41).Resize(1, 42).Copy

ورقة1.Range("A6:A" & ورقة1.Range("A65536").End(xlUp).Row + 1).PasteSpecial xlPasteValues

Set SRH_ALI = .FindNext(SRH_ALI)

Loop While Not SRH_ALI Is Nothing And SRH_ALI.Address <> firstAddress

MsgBox " تم جلب التقرير بنجاح", vbInformation, "الحمد لله"

Application.ScreenUpdating = True

Else

MsgBox "القيمة المدخلة خطاء أعد الإدخال وتأكد من حالة الأحرف"

Exit Sub

End If

End With

End Sub

وهذه المرفقات

للعلم بالامكان عمل الفرز بالتصفية المتقدمة

مطلوب فرز ALIDROOS.rar

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

[Ahmed Elbhiry]

مشكور اخى ابو نصار

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

امطلوب فرز ALIDROOS.zip

[الـعيدروس]

مرفقك هو حل التصفية المتقدمة

جزك الله خير

[أ / محمد صالح]

بارك الله لك أخي العيدروس

وبناء على طلب أستاذ أحمد

تم تعديل الكود ليتم استدعاؤه من صفحة أخرى ولتكن مثلا sheet3

mas_مطلوب فرز ALIDROOS.rar

[خالد القدس]

السلام عليكم

طرق فزر متنوعة ورائعة جدا

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

[Ahmed Elbhiry]

بارك الله لك أخي العيدروس

وبناء على طلب أستاذ أحمد

تم تعديل الكود ليتم استدعاؤه من صفحة أخرى ولتكن مثلا sheet3

شكرا جزيلا استاذ محمد برجاء التكرم بأضافة كوذ يعيد الصفحة الى قبل الفرز

تم تعديل يناير 12, 2012 بواسطه Ahmed Elbhiry

[أ / محمد صالح]

بارك الله لك أخي العيدروس

وبناء على طلب أستاذ أحمد

تم تعديل الكود ليتم استدعاؤه من صفحة أخرى ولتكن مثلا sheet3

شكرا جزيلا استاذ محمد برجاء التكرم بأضافة كوذ يعيد الصفحة الى قبل الفرز

أخي الكريم

استعمل هذا الكود

Sub nofilter()

ActiveSheet.ShowAllData

End Sub

[الـعيدروس]

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

وبرضة هذا الكود تسجيل ماكرو

Sub Macro1()

    Selection.AutoFilter

End Sub

[القومي]

الاستاذ / ابو نصار

والاستاذ / محمد صالح

اكثر من ممتاز

[القومي]

الاساتذة الافاضل /

هل من الممكن اضافة تحديد كود طباعة للنطاق المحدد للفرز

[Ahmed Elbhiry]

كل الشكر والتقدير لكل السادة الزملاء داعيا الله ان يزيدكم علما

مطلوب تصحيح كود الناجح مع تحديث البيانات

تصحيح كود ناجح.zip

تم تعديل يناير 13, 2012 بواسطه Ahmed Elbhiry

[عبدالله المجرب]

كل الشكر والتقدير لكل السادة الزملاء داعيا الله ان يزيدكم علما

مطلوب تصحيح كود الناجح مع تحديث البيانات

قم بازالة الارتباط التشعبي من زر امر الناجح دور ثاني

[Ahmed Elbhiry]

كل الشكر والتقدير لكل السادة الزملاء داعيا الله ان يزيدكم علما

مطلوب تصحيح كود الناجح مع تحديث البيانات

قم بازالة الارتباط التشعبي من زر امر الناجح دور ثاني

شكرا ابو هديل

هههههههههههه يموت المعلم ولا يتعلم

[عبدالله المجرب]

تم اختصار الكود

Public x As Integer

Sub Sort()

Dim WS As Worksheet, MyRng As Range

Set WS = Sheets("ناجح وراسب ومحول دور ثانى"): Set MyRng = WS.Range("A7:AA1207")

WS.Select

Range("AA2").Value = x

    MyRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _

	    WS.Range("aa1:aa2"), Unique:=False

Range("aa2").Select

End Sub

Sub ناجح_دورثانى()

x = 1

Call Sort

End Sub

Sub راسب_دورثانى()

x = 2

Call Sort

End Sub

Sub محول_دورثانى()

x = 3

Call Sort

End Sub

قم بمسح الكود الاول بالكامل (كل الاجراءات) واستبدله بهذا

[Ahmed Elbhiry]

تم اختصار الكود

 Public x As Integer Sub Sort() Dim WS As Worksheet, MyRng As Range Set WS = Sheets("ناجح وراسب ومحول دور ثانى"): Set MyRng = WS.Range("A7:AA1207") WS.Select Range("AA2").Value = x MyRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ WS.Range("aa1:aa2"), Unique:=False Range("aa2").Select End Sub Sub ناجح_دورثانى() x = 1 Call Sort End Sub Sub راسب_دورثانى() x = 2 Call Sort End Sub Sub محول_دورثانى() x = 3 Call Sort End Sub 

قم بمسح الكود الاول بالكامل (كل الاجراءات) واستبدله بهذا

بسم الله ماشاء الله

ربنا يزيدك من علمه

[Ahmed Elbhiry]

تم اختصار الكود

 Public x As Integer Sub Sort() Dim WS As Worksheet, MyRng As Range Set WS = Sheets("ناجح وراسب ومحول دور ثانى"): Set MyRng = WS.Range("A7:AA1207") WS.Select Range("AA2").Value = x MyRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ WS.Range("aa1:aa2"), Unique:=False Range("aa2").Select End Sub Sub ناجح_دورثانى() x = 1 Call Sort End Sub Sub راسب_دورثانى() x = 2 Call Sort End Sub Sub محول_دورثانى() x = 3 Call Sort End Sub 

قم بمسح الكود الاول بالكامل (كل الاجراءات) واستبدله بهذا

بسم الله ماشاء الله

ربنا يزيدك من علمه

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

اضافة جزء للكود يقوم بذلك