الخالدي

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

وعليكم السلام ورحمة الله وبركاته شكرا لمرورك اختي الفاضلة أم عبد الله جزاك الله خيراً لك مني كل التقدير والاحترام

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

الكود التالي يقوم بالمعالجة في عمود الاسماء بالتالي لا يحتاج الى عمود اضافي Sub AL_KHALEDI() Set Rn = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) Lr = Rn.Rows.Count ReDim Arr(Lr - 1) For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", 1) If Not IsError(S) Then T1 = Mid("أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Range("B2:J2").Resize(Lr).Sort Range("B2"), xlAscending A = 0 For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", 1) If Not IsError(S) Then T1 = Mid("أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Set Rn = Nothing: Erase Arr End Sub

السلام عليكم ورحمة الله جرب المحاولة بالكود المرفق والكود يعتمد على عمود اضافي فارغ (العمود K) تم الغاء دمج الخلايا في العمود K (الخلية K154) حتى يعمل الكود Sub AL_KHALEDI() Set Rn = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) Lr = Rn.Rows.Count ReDim Arr(Lr - 1) For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Search(T1, "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", 1) If Not IsError(S) Then T1 = Mid("أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("K2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Range("B2:K2").Resize(Lr).Sort Range("K2"), xlAscending Range("K2").Resize(Lr).ClearContents Set Rn = Nothing: Erase Arr End Sub في امان الله جدول تصفية المنح معدل جديد2.rar

السلام عليكم ورحمة الله بارك الله فيك اخي الاستاذ حمادة عمر ربما صاحب الموضوع يقصد ما هو موجود في ورقة EVENT OVERVIEW فتلك هي مقسمات طريقة العرض وتعمل مع الجداول المحورية PivotTable لغرض التصفية السريعة للبيانات http://office.microsoft.com/client/helppreview14.aspx?AssetId=HA010359466&lcid=1025&NS=EXCEL&Version=14&pid=CH010369156&CTT=4 في امان الله

السلام عليكم ورحمة الله بارك الله بالفاضلة / ام عبدالله ايضا كما في المرفق يتم الاحتفاظ بملف PDF في ملف الاكسل وذلك عن طريق ادراج كائن وتفعيل خيار عرض كايقونة في امان الله B.rar

السلام عليكم ورحمة الله الفاضل / أبو محمد عباس جرب الكود التالي Sub AL_KHALEDI() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Sheets("بيانات الطلبة حسب الحروف") Intersect(.Range("B5").Resize(9999, 11 * 28), .UsedRange).ClearContents For Each C In Range(Sheets("بيانات الطلبة").[B4], Sheets("بيانات الطلبة").Cells(Rows.Count, 2).End(xlUp)) T = Mid(Trim(C), 1, 1) If T = "ج" Then T = "ح" Else If T = "ح" Then T = "ج" M = Application.Match(T, [{"A","ب","ت","ث","ج","ح","خ","د","ذ","ر","ز","س","ش","ص","ض","ط","ظ","ع","غ","ف","ق","ك","ل","م","ن","ه","و","ي"}]) If Not IsError(M) Then Lc = (M * 11) - 11 + 3 Lr = Application.Max(5, .Cells(Rows.Count, Lc).End(xlUp).Row + 1) .Cells(Lr, Lc - 1).Value = Lr - 4 .Cells(Lr, Lc).Resize(1, 8).Value = C.Resize(1, 8).Value Else: Er = Er + 1: End If Next End With MsgBox "تم بحمد الله" & IIf(Er > 0, vbCr & Application.Rept("=", 30) & vbCr & "عدد الاسماء الخطا غير المرحلة" & vbCr & Er, "") Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub في امان الله

اللهم امين

نسال الله ان يشفيه وينعم عليه بدوام الصحة والعافية

السلام عليكم ورحمة الله جرب الكود التالي Sub AL_KHALEDIادراج_الشعب() Set نظاق_الشعب = [H3] Set نظاق_التعبئة = [D2:D33] عددالشعب = [F3] عددالصفوف = نظاق_التعبئة.Rows.Count عددالتكرار = Int(عددالصفوف / عددالشعب) الفارق = عددالصفوف Mod عددالشعب For شعب = 1 To عددالشعب If الفارق > 0 Then عددالشعبةالحالية = عددالتكرار + 1 الفارق = الفارق - 1 Else عددالشعبةالحالية = عددالتكرار End If For شعبة = 1 To عددالشعبةالحالية الصف = الصف + 1 نظاق_التعبئة(الصف, 1).Value = نظاق_الشعب(شعب, 1).Value Next Next Set نظاق_الشعب = Nothing: Set نظاق_التعبئة = Nothing End Sub في امان الله ادراج الشعب.rar

السلام عليكم الفاضل/أبو محمد عباس جرب الحل المرفق باستخدام معادلات صفيف تم تحويل ارقام المدرسين من تنسيق نص الى تنسيق عام بسبب ان بعضها كانت نص والاخر عام وهو ما كان يسبب خطا في نتائج المعادلات واتمنى ان تجد من الاخوة حل ابسط واقل تعقيدا في امان الله استدعاء مواد المدرسين تحت اسمائهم مع الفصل شرح2.rar

السلام عليكم اعمل نطاق طباعة خاص بالورقة (ورقة1) ثم ادخل المعادلة التالية =OFFSET=OFFSET(!$A$3:$I$3;0;;MAX((!$A3:$A$1000<>"")*ROW(!$A3:$A$1000));) نطاق الطباعة (Print_Area) في ملفك غير صحيح لأنه معرف على مستوى الملف وليس على مستوى الورقة حيث يجب ان يكون لكل ورقة نطاق طباعة خاص بها ومعرف على مستواها ولإثراء الموضوع في الملف المرفق استخدمت معادلة واحدة لتحديد نطاق الطباعة في اي ورقة حسب اخر صف في العمود A والمعادلة المستخدمة هي المعادلة السابقة مع ازالة اسم الورقة وابقاء رمز الورقة بحيث تصبح الورقة النشطة هي مرجع المعادلة =OFFSET(!$A$3:$I$3;0;;MAX((!$A3:$A$1000<>"")*ROW(!$A3:$A$1000));) تم اعطاء اسم للمعادلة(طباعة) بحيث يتم الاشارة اليه في نطاقات طباعة الاوراق ارجو ان يكون المطلوب ‫تحديد نطاق طباعة تلقائي.rar

السلام عليكم ورحمة الله اخي الكريم جرب الكود التالي Sub AL_KHALEDIفرزمخصص() Set Rn1 = [A1] Set Rn2 = [D1] Set Rn1 = Range(Rn1, Rn1(Cells(1000, Rn1.Column).End(xlUp).Row, 1)) CLC1 = Application.CustomListCount Application.AddCustomList ListArray:=Rn1 On Error GoTo Error: CLC2 = Application.CustomListCount L1 = Cells(Rows.Count, Rn2.Column).End(xlUp).Row Set Rn3 = Range(Rn2, Rn2(L1, 1)) Dim Arr() For Each Rc1 In Rn1.Cells If Application.CountIf(Rn3, Rc1) = 0 Then ReDim Preserve Arr(L2) Arr(L2) = Rc1.Value L2 = L2 + 1 Rn2(L1 + L2, 1).Value = Rc1.Value End If Set Rn3 = Range(Rn2, Rn2(L1 + L2, 1)) Next Rc1 Rn3.Sort Rn3(1, 1), xlAscending, Header:=xlNo, OrderCustom:=CLC2 + 1 For Each Rc3 In Rn3.Cells If Not IsError(Application.Match(Rc3, Arr, 0)) Then Rc3.Value = "" Next Rc3 Error: If CLC2 > CLC1 Then Application.DeleteCustomList ListNum:=CLC2 End If Set Rn1 = Nothing: Set Rn2 = Nothing: Set Rn3 = Nothing Erase Arr End Sub في امان الله

السلام عليكم ورحمة الله اضافة الى ما ذكره اخي الفاضل الاستاذ بن علية حفظه الله اذا تستخدم -معالج استيراد النص- لفتح ملف تكست كرر عملية الفتح ثم من خيار –بدء الاسترداد عند الصف- حدد الرقم65537 وهكذا قم بإضافة الرقم 65536 الى رقم الصف في كل عملية فتح الى ان تنتهي ويمكنك عمل ماكرو يقوم بعملية الفتح وتكرارها واذا تستخدم -معالج استيراد النص- عن طريق الاتصال وليس عن طرق فتح الملف فان الاستيراد يكون من الصف 1 فقط ما ورد اعلاه من واقع التجربة على اكسل2007 في امان الله

السلام عليكم ورحمة الله وبركاته شهر مبارك وكل عام وانتم بخير بعد اذن الاخوة الكرام جرب المعادلة التالية: =SUM(IF(MATCH($D$5:$D$13&$A$5:$A$13;$D$5:$D$13&$A$5:$A$13;0)=ROW($A$5:$A$13)-ROW($A$5)+1;IF($B$5:$B$13="مرتجع";-1;1);0)) ملاحظة : يجب ادخال المعادلة كمعادلة صفيف (بالضغط CTRL+SHIFT+ENTER) ارجو ان تحقق بالمطلوب في أمان الله اجمالي عدد القيم الفريدة-ثلاثة مستويات.rar

السلام عليكم ورحمة الله وبركاته اضافة الى حل الاخت الفاضلة أم عبد الله ادخل المعادلة التالية في الخلية A6 ثم اسحبها حتى الخلية I6 =A4&LOOKUP(2; 1/($A$3:A$3<>""); $A$3:A$3) او =A4&LOOKUP("ے";$A$3:A$3) في أمان الله

السلام عليكم ورحمة الله وبركاته حسب فهمي للمطلوب ادخل المعادلة التالية في الخلية H5 ثم اسحبها حتى الخلية D5 =MAX(0;MIN(H4;$C5-SUM(H4:$H4)+H4)) في أمان الله

شكرا لمن مر على الموضوع وجزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته ماهو الوضع عند تساوي قيمتين او اكثر شاهد المرفق ربما تجد فيه طلبك في أمان الله نظام الاقساط المدرسية 2013.rar

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

شاهد المرفق ترتيب حسب المجموع والتاريخ والاسم2.rar

السلام عليكم ورحمة الله وبركاته النتائج غير صحيحة بسبب وجود كسور عشرية في المجموع حاول ان تجعل المجموع ارقام صحيحة وإلا تحتاج الى تعديل في المعادلة في أمان الله

شكرا لثنائك الطيب اسعدني مرورك الكريم في أمان الله