محمد حجازي

السلام عليكم ... اضف السطر التالي قبل End If : Me.Cells(Me.Range("A1").CurrentRegion.Rows.Count + 1, 1).Select بالتوفيق

السلام عليكم ... بالنسبة لمشكلتك الأولى : راجع الرابط التالي : http://www.officena.net/ib/index.php?showtopic=6814 بالنسبة لمشكلتك الثانية : ابحث في المنتدى عن "التنسيق الشرطي"

السلام عليكم ... الرجاء تو ضيح المشكلة بشكل أكثر تفصيلاً : هل كان مصدر البيانات عبارة صفحة ويب أم من ملف xml أم ماذا ...

السلام عليكم ... من الممكن الاعتماد على الأسلوب UsedRange من أجل الحصول على مجال البيانات المليئة في الورقة (يختلف عن الأسلوب CurrentRegion في أنه لا يتأثر بالثغرات الفارغة الموجودة بين البيانات ، هذا فضلاً عن تأثره بتنسيقات الخلايا) . الكود التالي يقوم بإخفاء الصفوف اعتماداً على العامود الأول من نطاق البيانات الموجود (ليس بالضرورة أن يكون العامود A) و ذلك تمهيداً لطباعتها ، ومن ثم يقوم بإظهار الصفوف المخفاة مجدداً : Sub MyPrint() Application.ScreenUpdating = False With Sheets("Sheet1") With .UsedRange For i = 1 To .Rows.Count If .Cells(i, 1).Value = "" Then .Cells(i, 1).EntireRow.Hidden = True End If Next i End With .PrintOut .Rows.Hidden = False End With Application.ScreenUpdating = True End Sub بالتوفيق MyPrint.rar

السلام عليكم ... هذا الملف معدل : وقد اعتمدت في توزيع الأرقام على نفس الصيغة المستخدمة في التنسيق الشرطي . 000.zip

السلام عليكم ... بالنسبة للسؤال الأول : السلسلة الخطية هي السلسلة التي إذا مثلناها بيانياً فإن شكل الانتشار الناتج عنها سيكون عبارة عن خط مستقيم (تابع صحيح من الدرجة الأولى) ، وهذه التوابع إما أن تكون متزايدة : y=5X+2 أو متناقصة : y=-6X+7 أو ثابتة : y=5 هذا طبعاً بالنسبة للتوابع المستمرة (التوابع التي يمكن للمتغير المستقل X فيها أخد أي قيمة موجودة ضمن مجال محدد). أما بالنسبة للتوابع الغير مستمرة ، فالمتوالية الحسابية هي خير مثال لها (على خلاف المتوالية الهندسية) ، وذلك لأن ما يميز التوابع الخطية هو أن مقدار الزيادة أو النقص فيها ثابت (كالمتواليات الحسابية دون الهندسية) بالنسبة للسؤال الثاني : هذا يعني أن المشتق الأول للتابع الممثل لهذه السلسلة هو 0.8 (في حالة السلاسل المستمرة) ، و أن أساس المتوالية الحسابية الممثلة لهذه السلسلة هو 0.8 (في حالة السلاسل الغير مستمرة). الخلاصة : كل عنصر من هذه السلسلة ينتج عن العنصر السابق له مباشرة بعد إضافة العدد 0.8 (طبعاً الكلام بالنسبة للتوابع الغير مستمرة). بالنسبة للسؤال الثالث : بفرض أن الخلية التي تحتوي على صافي المرتب هي الخلية A1 ، فتكون عندئذ الصيغة : =IF(A1<=1600;"ضعيف";IF(A1<=2500;"مقبول";IF(A1<=3000;"جيد";IF(A1<=5000;"جيد جداً";"ممتاز")))) بالنسبة للسؤال الرابع : ابحثي في المنتدى عن التنسيق الشرطي . بالتوفيق

السلام عليكم ... حسب خبرتي المتواضعة في الاكسل ، لم أجد مناص من استخدام خليتين منفردتين لإتمام العملية السابقة.

5. جعل الجملة With خارج الحلقات التكرارية : تحدثنا في المشاركة الثالثة عن كيفية استخدام الجملة With من اجل تقليل الحاجة لاستدعاء الأهداف المختلفة ، ولكن يجب على كل من يريد استخدام هذه الجملة الانتباه لوضعا خارج الحلقات التكرارية (وذلك من أجل زيادة كفاءة هذه الجملة أكثر و أكثر) ، لاحظ الأكواد التالية : Sub MyFunction1() Dim X As Byte For X = 1 To 10 Sheets("Sheet1").Cells(X + 1, 2).Value = 2 * X + 6 Sheets("Sheet1").Cells(X + 1, 3).Value = X ^ 2 - X + 7 Sheets("Sheet1").Cells(X + 1, 4).Value = 23 * X - 20 Sheets("Sheet1").Cells(X + 1, 5).Value = X ^ 3 + 55 * X ^ 2 + 6 Sheets("Sheet1").Cells(X + 1, 6).Value = 2 * X Next X End Sub Sub MyFunction2() Dim X As Byte For X = 1 To 10 With Sheets("Sheet1") .Cells(X + 1, 2).Value = 2 * X + 6 .Cells(X + 1, 3).Value = X ^ 2 - X + 7 .Cells(X + 1, 4).Value = 23 * X - 20 .Cells(X + 1, 5).Value = X ^ 3 + 55 * X ^ 2 + 6 .Cells(X + 1, 6).Value = 2 * X End With Next X End Sub Sub MyFunction3() Dim X As Byte With Sheets("Sheet1") For X = 1 To 10 .Cells(X + 1, 2).Value = 2 * X + 6 .Cells(X + 1, 3).Value = X ^ 2 - X + 7 .Cells(X + 1, 4).Value = 23 * X - 20 .Cells(X + 1, 5).Value = X ^ 3 + 55 * X ^ 2 + 6 .Cells(X + 1, 6).Value = 2 * X Next X End With End Sub الأكواد الثلاثة السابقة تقوم بنفس العمل (حساب قيمة المتغير التابع y لعدد من المعادلات عند قيم محددة للمتغير المستقل X "من 1 إلى 10"). نلاحظ أنه تم استدعاء الهدف : Sheets("Sheet1") 50 مرة في الكود الأول ، و 10 مرات في الكود الثاني ، ومرة واحدة في الكود الثالث . عملية الاستدعاء للهدف السابق تؤثر حتماً على سرعة الكود (الكود الثالث هو الأسرع يليه الثاني ثم الأول) ، لاحظ كيف أن عملية استدعاء الهدف السابق قد تقلصت بعد وضع الجملة With خارج الحلقة التكرارية For ... Next . (y) لا تقلق أخي إذا لم تشعر بتغير سرعة الكود وذلك لأن الفرق أقل من أي يدرك بسهولة ...... ولكن مهلاً أخي ، ستشعر بالفرق في حالة وجود عمليات كثيرة تجرى على بيانات كبيرة. هل انتهى الحديث ؟!!!!!! لا أعتقد ذلك : أثناء كتابتي للدرس تذكرت أحد الاستعمالات الغامضة للجملة With : إذا قررت (بعد أن ابيض شعرك) القيام بحفظ جدول الضرب و التخلص من هذه العقدة التي عانيت منها كثيراً :) . أول الخطوات ستكون إحضار الجدول ( ولكن من أين؟ :o ) . حسناً لديك عدة خيارات : استعارة دفتر ولدك الصغير ، طلب الجدول من المكتبة (من أجل ولدك طبعاً :d ) ، القيام بتصميم الجدول عن طريق الاكسل : أول ما سيخطر على بالك هو الكود التالي : Sub MultiplicationTable1() Dim i As Byte, ii As Byte For i = 1 To 10 For ii = 1 To 10 Sheets("Sheet2").Cells(i, ii) = i * ii Next ii Next i End Sub ولكن ، و بما أن وقتك غالي عليك و تريد استثمار كل ثانية منه لحفظ جدول الضرب ، فإنك ستفضل حتماً التعديل التالي في الكود السابق : Sub MultiplicationTable2() Dim i As Byte, ii As Byte With Sheets("Sheet2") For i = 1 To 10 For ii = 1 To 10 .Cells(i, ii) = i * ii Next ii Next i End With End Sub لاحظ أخي أن الهدف : Sheets("Sheet2") تم استدعائه 100 مرة في الكود الأول و مرة واحدة فقط في الكود الثاني. (y) مرفق ملف يتضمن الأكواد الموجودة في هذه المشاركة : بالتوفيق WithAndLoops.zip

السلام عليكم ... بالنسبة للدوال ، لم تمر علي دالة في مجموعة البحث و المراجع تختص بذلك . بالنسبة للحل بواسطة الـ VBA ، يمكنني عمل ذلك بسهولة . إذا رغبت بكود VBA فأخبرني لأكتبه لك.

السلام عليكم ... يمكنك وضع وقت المكالمة في خلية و التوقيت في خلية ثانية و من ثم جمع الناتج عن طريق المحرف & أو الدالة CONCATENATE . راجع الرابط التالي : http://www.officena.net/ib/index.php?showtopic=7481

السلام عليكم ... جرب الكود التالي : Sub Sort_ManySheets() Dim MyData() As Double Dim i As Long Dim ii As Long Dim n As Long Dim EndRow As Long Dim NumberLevels As Long Dim EndRowOfMyRange As Long NumberLevels = 10 EndRowOfMyRange = 100 MySheets = Array("1", "2", "3") On Error GoTo OutOfRange For Each ThisSheet In MySheets For i = 1 To NumberLevels ReDim Preserve MyData(UBound(MyData) + 1) MyData(UBound(MyData)) = Application.WorksheetFunction.Large(Sheets(ThisSheet).Range("B2:B" & EndRowOfMyRange), i) Next i Next ThisSheet On Error GoTo 0 Sheets("Result").Range("A2:B65536").ClearContents For i = 1 To UBound(MyData) If i = 1 Then GoTo 1 If Application.Large(MyData, i - 1) = Application.Large(MyData, i) Then GoTo 2 1 For Each ThisSheet In MySheets With Sheets(ThisSheet) For ii = 2 To EndRowOfMyRange If .Cells(ii, 2).Value = Application.Large(MyData, i) Then EndRow = Sheets("Result").Range("A1").CurrentRegion.Rows.Count Sheets("Result").Cells(EndRow + 1, 1) = .Cells(ii, 1).Value Sheets("Result").Cells(EndRow + 1, 2) = .Cells(ii, 2).Value End If Next ii End With Next ThisSheet n = n + 1 If n = NumberLevels Then Exit Sub 2 Next i Exit Sub OutOfRange: If Err = 9 Then ReDim MyData(0) On Error GoTo NoResult Resume Next End If NoResult: If Err = 1004 Then ReDim Preserve MyData(UBound(MyData) - 1) Resume Next Else Error Err End If End Sub أنا لا أعرف بالضبط ما سيكون عليه الحال في مصنفك ، ولذلك فقد تركت بعض الأمور التي يجب عليك تعديلها في الكود : NumberLevels = 10 هنا يجب عليك تحديد عدد المتسويات التي تريد ظهورها في الورقة Result (الرقم الافتراضي 10) . EndRowOfMyRange = 100 هنا يجب عليك تحديد رقم آخر سطر في جداول الطلاب الموجودة في الأوراق المختلفة (الرقم الافتراضي 100). MySheets = Array("1", "2", "3") هنا يجب عليك تحديد الأوراق التي تريد اجراء عملية الفرز على بياناتها. بالنسبة للكود ، لم أستطع تجريبه بصورة موسعة ، ولذلك فأرجو منك تجريبة على بيانات مختلفة و إعلامي بالنتيجة . مرفق الملف مع التعديل الأخير : تحياتي sort.zip

السلام عليكم ... أخي ، جرب التعديل التالي : و قد اعتبرت الترتيب يبدأ من شهر فبراير (فبراير = 1). 0.zip

السلام عليكم ... الكود هو التالي: Sub m() Dim NumberRow As Long Application.ScreenUpdating = False For i = 3 To 12 If Sheets("1").Cells(i, 1).Value <> "" Then For ii = 1 To Sheets("1").Cells(i, 1).Value NumberRow = Sheets("2").Range("A2").CurrentRegion.Rows.Count Sheets("2").Cells(NumberRow + 1, 1).Value = NumberRow - 1 Sheets("2").Cells(NumberRow + 1, 18).Value = Sheets("1").Cells(i, 2).Value Sheets("2").Cells(NumberRow + 1, 2).Value = 2 For iii = 3 To 17 Sheets("2").Cells(NumberRow + 1, iii).Value = Sheets("1").Cells(i, iii + 2).Value Next iii Next ii End If If Sheets("1").Cells(i, 3).Value <> "" Then For ii = 1 To Sheets("1").Cells(i, 3).Value NumberRow = Sheets("2").Range("A2").CurrentRegion.Rows.Count Sheets("2").Cells(NumberRow + 1, 1).Value = NumberRow - 1 Sheets("2").Cells(NumberRow + 1, 19).Value = Sheets("1").Cells(i, 4).Value Sheets("2").Cells(NumberRow + 1, 2).Value = 1 For iii = 3 To 17 Sheets("2").Cells(NumberRow + 1, iii).Value = Sheets("1").Cells(i, iii + 2).Value Next iii Next ii End If Next i Sheets("1").Range("A1:S12").ClearContents Application.ScreenUpdating = True End Sub وهذا شرح للكود خطوة خطوة : Dim NumberRow As Long هنا عرفنا المتغير NumberRow على أنه عدد صحيح طويل . Application.ScreenUpdating = False هنا ألغينا خاصية تحديث الشاشة . For i = 3 To 12 هذه حلقة تكرارية يتم من خلالها إسناد رقم (من 3 إلى 12) في المتغير i في كل دورة . If Sheets("1").Cells(i, 1).Value <> "" Then إذا كانت قيمة الخلية التي تقع في السطر i و العامود الأول (في الورقة 1) فارغة فيتم تنفيذ السطر التالي وإلا فلا . For ii = 1 To Sheets("1").Cells(i, 1).Value هذه حلقة تكرارية يتم من خلالها إسناد رقم (من 1 إلى قيمة الخلية الواقعة في السطر i و العامود الأول) في المتغير ii في كل دورة . NumberRow = Sheets("2").Range("A2").CurrentRegion.Rows.Count في السطر السابق يتم إسناد رقم آخر سطر في جدول البيانات (الموجود في الورقة 2) في المتغير NumberRow . Sheets("2").Cells(NumberRow + 1, 1).Value = NumberRow - 1 هذا السطر خاص بوضع التسلسل التلقائي لجدول البيانات . Sheets("2").Cells(NumberRow + 1, 18).Value = Sheets("1").Cells(i, 2).Value هذا السطر خاص بالمبلغ الدائن. Sheets("2").Cells(NumberRow + 1, 2).Value = 2 هذا السطر خاص بمميز الحركة. For iii = 3 To 17 Sheets("2").Cells(NumberRow + 1, iii).Value = Sheets("1").Cells(i, iii + 2).Value Next iii الكود السابق خاص بنقل رقم الحساب . If Sheets("1").Cells(i, 3).Value <> "" Then For ii = 1 To Sheets("1").Cells(i, 3).Value NumberRow = Sheets("2").Range("A2").CurrentRegion.Rows.Count Sheets("2").Cells(NumberRow + 1, 1).Value = NumberRow - 1 Sheets("2").Cells(NumberRow + 1, 19).Value = Sheets("1").Cells(i, 4).Value Sheets("2").Cells(NumberRow + 1, 2).Value = 1 For iii = 3 To 17 Sheets("2").Cells(NumberRow + 1, iii).Value = Sheets("1").Cells(i, iii + 2).Value Next iii Next ii End If هذا الكود يقوم بنفس عمل ما سبق و لكن مع المبالغ المدينة. Sheets("1").Range("A1:S12").ClearContents هنا قمنا بمسح محتويات النموذج الذي قمنا بالترحيل منه. Application.ScreenUpdating = True هنا قمنا بإعادة خاصية تحديث الشاشة.

السلام عليكم ... هذه بعض اختصارات لوحة المفاتيح التي استخدمها في الاكسل ، أرجو أن تنال إعجابكم . Keyboard_Shortcut.zip

السلام عليكم ... لقد بدأت بكتابة الكود الخاص بمشكلتك و لكني توقفت عند تساؤل : إذا كان هناك طالبان لهما نفس الدرجة ، هل تريد جعلها في مرتبة واحدة ؟ (مثلاً 2 مكرر)

السلام عليكم ... على ما أعتقد أن هذه الرسالة تظهر عندما يكون هناك تداخل غير منطقي في الدوال ، حلقة غير منطقية. فمثلاً إذا وضعت في الخلية A1 الصيغة التالية : =SUM(C1:D1) ومن ثم أدرجت الصيغة التالية في الخلية C1 : =A1 فسوف يظهر لك الخطأ السابق ، وذلك نتيجة تداخل العمليات (لأن القيمة الموجودة في الخلية C1 هي أحد مدخلات الصيغة الموجودة في الخلية A1). بالتوفيق

السلام عليكم ... الرجاء التوضيح بمثال عملي ، لأنني لم أفهم المقصود.

السلام عليكم ... يعطيك العافية أخ أبو هادي . الأيام و الشهور عندي بالعربية. تحياتي

السلام عليكم ... بنفس الطريقة مع وضع التنسيق : dddd في الخلية الجديدة.

السلام عليكم ... بالنسبة لسؤالك و اجهتني مشكلتين : المشكلة الأولى : تكمن في الدالة VLOOKUP وذلك لأنها تعتمد على البحث عن العامود الأول من المجال المحدد وهذا لا ينطبق في الاتجاهين . لذلك قمت بإضافة العامود H لحل المشكلة. المشكلة الثانية : تكمن في الحدث الذي اعتمدت عليه لتشغيل الكود ، وهو الحدث Change مع الهدف Worksheet ، وبما أن الكود يعمل أيضاً على تغيير الخلية المقابلة فهذا سيؤدي إلى تفجير الحدث Change مرة أخرى و هكذااااااااا نشئت حلقة متكررة من الكود نفسة ، ولهذا فقد حللت المشكلة عن طريق إضافة المتغير الساكن MyCell . الكود هوالتالي: Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo NoValue Static MyCell As Boolean If MyCell = False Then If Target.Address = "$C$8" Then MyCell = True Me.Range("F8") = Application.WorksheetFunction.VLookup(Target.Value, Me.Range("I9:J12").Value, 2, False) Exit Sub ElseIf Target.Address = "$F$8" Then MyCell = True Me.Range("C8") = Application.WorksheetFunction.VLookup(Target.Value, Me.Range("H9:I12").Value, 2, False) End If Else MyCell = False End If Exit Sub NoValue: If Err <> 1004 Then MsgBox Err.Description End If End Sub بالتوفيق Employee_List1.zip

السلام عليكم ... تمت إضافة الملفات كمرفقات في المشاركة الأولى للأخ smart . تحياتي

السلام عليكم ... جرب التعديل التالي: 16834_New1.zip

السلام عليكم ... جرب التعديل البسيط التالي: sort.zip

السلام عليكم ... بارك الله فيكم وجعل هذا البرنامج في ميزات حسناتكم . (y) لا أخفي عنكم أنني بدأت بالتفكير في عمل مشروع جماعي في قسم الاكسل . :d

السلام عليكم ... جرب التعديل التالي: عملت على جعل البرنامج يحفظ الورقة بنفس اسمها و في نفس مسار الملف الأصلي ، و إذا كنت تريد تحديد اسم الورقة أو مسارها بنفسك فأخبرني لأعدل لك الكود. 16834_New.zip