محمد حجازي

السلام عليكم ... جرب الصيغة التالية : =IF(AND(A1>=85%;A1<=100%);"ط1";IF(AND(A1>=60%;A1<85%);"ط2";IF(AND(A1>=45%;A1<60%);"ط3";IF(AND(A1>=1%;A1<45%);"ط4";""))))

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

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

السلام عليكم ... أقدم لكم تجربتي الأولى مع الاكسل (أيام الدراسة) ، وهو برنامج يحسب اهتلاك الأصول الثابتة بعدة طرق. قمت بإضافة هذا البرنامج في أحد المنتديات وتذكرت أني لم أضعه في منتدى أوفيسنا ، ولذلك (ومن باب أولى) يتحتم علي تقديمه لأعضاء على هذا المنتدى الرائع. البرنامج مصمم على الأوفيس 97 وقد حدثت الملف ليتماشى مع نسخة 2003 ، وكما قلت لكم فإن هذا البرنامج يمثل أول تجربة لي في التعامل مع الاكسل (يوم كنا أولاد) لذلك أرجو عدم معاتبتي على الأخطاء التي قد تجدونها فيه. :d بالتوفيق Assets.zip

السلام عليكم ... عند عملية الفرز فإن الاكسل يعتبر كل صف بمثابة سجل كامل وبالتالي فإن عملية فرز القيم الموجودة في عامود معين سوف تأثر على القيم المقابلة لها في العامود الآخر ، أي أن الاكسل عملياً يعتبر ورقة العمل بأكملها بمثابة جدول بيانات حقوله تبدأ من العامود A وتنتهي بالعامود IV (جميع أعمدة الورقة). ولكن هل فكرتم بإمكانية فرز القيم الموجودة في عامود (حقل) معين مع تحديد مجال جدول البيانات ، أي تحديد الخلايا المتأثرة بهذا الفرز؟!!! الحل بسيط : كليك يمين ومن ثم الخيار Create List لتظهر لك نافذة حدد من خلالها مجال جدول البيانات المرغوب و اضغط OK . الآن جرب فرز القيم الموجودة في القائمة المنشئة ولاحظ عدم تأثر البيانات الموجودة خارج القائمة بأي عملية تجريها على عناصر هذه القائمة. بالتوفيق...

السلام عليكم ... السبب في عدم قناعتي بالكود هو أنه لا يتأثر فقط بالضغط على الأسهم وإنما يتأثر أيضاً عندما تقوم بتحديد الخلايا بواسطة الفأرة.

السلام عليكم ... الرجاء تحميل مثال مبسط لمشكلتك في قسم التحميل المؤقت ، وذلك لأن كل حالة تحتاج لطريقة حل مختلفة عن الحالة الأخرى.

السلام عليكم ... للأسف الحدث KeyDown غير متاح في الهدف Worksheets ، ولكن وعلى أية حال فقد يفيدك الكود التالي (رغم عدم قناعتي به): Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo 1 Static LastCells As Range If LastCells.Row = Target.Row And LastCells.Column = 13 And Target.Column = 14 Then Cells(Target.Row + 1, 2).Select End If 1 Set LastCells = Target End Sub ولا تنسى لصقه في الورقة المطلوب تطبيق الإجراء عليها.

السلام عليكم ... مشكلتك يا أخي ليست بحاجة لكود ، فقط ألغي قابلية خلايا الجدول للحماية ومن ثم احمي الورقة مع إزالة قابلية تحديد الخلايا المؤمنة ، تماماً كما في المثال الموجود في الرابط التالي: http://www.officena.net/ib/index.php?showtopic=5496 وعلى أية حال فإذا كنت تريد كود لمعالجة هذه المشكلة أخبرني لأكتبه لك.

السلام عليكم ... فقط نسيت أن أخبرك بأن الكود يصلح لكل الصفحات في حال كون أعمدة البيانات متوضعة في نفس الموقع وفي حالة الاعتماد على الخلية BI2 في الأوراق الثلاث.

السلام عليكم ... يمكنك وضع الكود في الـ Module وربطه بزر أمر . راجع قسم الخلاصات وستجد مشاركة للأخ حسام نور عن كيفية إدراج الكود وربطه بزر الأمر. بالتوفيق

السلام عليكم ... هذا الكود مع التعديل : Sub MoveValue() On Error GoTo 1 Dim EndRow As Long Dim MyCell As Range For i = 2 To ActiveWorkbook.Worksheets.Count EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count Set MyCell = Sheets(1).Range("A5:A7").Find(Sheets(i).Name) Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(MyCell.Row, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(MyCell.Row, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(MyCell.Row, 4).Value Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 1).Value = EndRow Sheets(1).Range(Cells(MyCell.Row, 2), Cells(MyCell.Row, 3)).ClearContents 1 Next i Sheets(1).Range("B1:B2").ClearContents End Sub ولكن انتبه للملاحظات التالية : - غير المجال الذي يحتوي على أسماء الأصناف من السطر السادس (من الكود) ، كأن تقوم مثلاً بتحديد مجال أعظمي للبيانات المدخلة. - يجب أن تكون أسماء الأصناف في ورقة الفاتورة مطابقة تماماً لأسماء الأوراق ، وإلا سيقوم الكود بتجاهل الصنف الغير معروف ولن يرحل صف هذا الصنف. - بالنسبة لمعادلة السعر × الكمية أضفها في العامود D ولن تمسح إن شاء الله. بالتوفيق

السلام عليكم ... لا أعرف بالضبط لماذا . على أية حال فأنا أقوم بكتابة الدالة في الورقة و الإشارة إلى مخرجاتها في ورقة أخرى من بواسطة كتابة مرجع الخلية الموجودة فيها الدالة.

السلام عليكم ... شكراً لك يا أخي أبو مؤنس. فقط إثباتاً للوقائع أردت أن أنوه إلى أن التنسيق الشرطي من تصميم صاحب الملف ابن الظاهر. وشكراً

السلام عليكم ... بالنسبة للمرفق تم التعديل و إعادة التحميل في المشاركة السابقة. بالنسبة لناحية الطباعة ، يمكن إعادة تعينها عن طريق الكود التالي: Sub MyPrintArea() Sheets(3).PageSetup.PrintArea = "$A$4:$AX$" & Sheets(3).Range("BI2").Value End Sub الكود السابق خاص بالصفحة الثالثة في المرفق (الصفحة 1) وحيث تمت إعادة ضبط الأسطر للطباعة اعتماداً على القيمة الموجودة في الخلية BI2. بالتوفيق

السلام عليكم ... الكود : Sub Salary() Dim NumberEmployee As Long Dim NumberMonth As Integer Dim Salary As Double Dim Result As Integer NumberEmployee = Application.InputBox(prompt:="أدخل رقم الموظف", Title:="رقم الموظف", Type:=1) NumberMonth = Application.InputBox(prompt:="أدخل رقم الشهر", Title:="رقم الشهر", Type:=1) Salary = Application.InputBox(prompt:="أدخل قيمة الراتب", Title:="الراتب", Type:=1) If NumberEmployee = False Or NumberMonth = False Or Salary = False Then Exit Sub ElseIf NumberEmployee < 10 Or NumberEmployee > 15 Then MsgBox prompt:="رقم الموظف يجب أن يكون أكبر أو يساوي 10 و أصغر أو يساوي 15", Title:="خطأ" Exit Sub ElseIf NumberMonth <> Sheets("Sheet1").Range("B2").Value Then MsgBox prompt:="رقم الشهر يجب أن يساوي الرقم الموجود في الخلية B2", Title:="خطأ" Exit Sub ElseIf Salary <> 100 And Salary <> 200 Then MsgBox prompt:=" الراتب يجب أن يكون إما 100 أو 200", Title:="خطأ" Exit Sub Else Set VMonth = Sheets("Sheet1").Range("A1:N1").Find(NumberMonth) Set Employee = Sheets("Sheet1").Range("A1:A100").Find(NumberEmployee) Result = MsgBox("الموظف هو " & Sheets("Sheet1").Cells(Employee.Row, 2).Value, vbYesNo, "الموظف الناتج عن البحث") If Result = vbYes Then Sheets("Sheet1").Cells(Employee.Row, VMonth.Column).Value = Salary End If End If End Sub

السلام عليكم ... شكراً أخي محمد طاهر على الرد الجميل

السلام عليكم ... ومن أجل حفظ الصفحة بدون ارتباطات مع الملف الأساسي إليك الكود التالي: Public NewWorkbok As Object Sub SaveSheet() Dim MyPath As String Dim NumberSheets() As Integer MyPath = Workbooks("MAH").Path & "\MAH_TEST" Set NewWorkbok = Workbooks.Add Workbooks("MAH").Sheets(1).Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1) ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count) For i = 2 To NewWorkbok.Worksheets.Count NumberSheets(i) = i Next i Application.DisplayAlerts = False With NewWorkbok .Sheets(NumberSheets).Delete .Sheets(1).Cells.Copy .Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Sheets(1).Cells(1, 1).Select .SaveAs Filename:=MyPath .Close End With Application.DisplayAlerts = True End Sub

السلام عليكم ... جرب الكود التالي: Public NewWorkbok As Object Sub SaveSheet() Dim MyPath As String Dim NumberSheets() As Integer MyPath = Workbooks("MAH").Path & "\MAH_TEST" Set NewWorkbok = Workbooks.Add Workbooks("MAH").Sheets(1).Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1) ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count) For i = 2 To NewWorkbok.Worksheets.Count NumberSheets(i) = i Next i Application.DisplayAlerts = False With NewWorkbok .Sheets(NumberSheets).Delete .SaveAs Filename:=MyPath .Close End With Application.DisplayAlerts = True End Sub ولكن انتبه إلى أن الكود يحفظ الصفحة الأولى الموجودة في المصنف MAH في مصنف جديد اسمه MAH_TEST بالتوفيق

السلام عليكم ... تم تعديل الملف وذلك من خلال الأعمدة من F إلى Q في ورقة الاسماء ، ولكن انتبه إلى التنسيق الشرطي الموجود مسبقاً في الملف لأنه يلغي أسماء موجودة. بالتوفيق School.zip

السلام عليكم ... الكود التالي يبحث عن رقم الشهر في المجال A1:N1 : Sub Salary() Dim NumberEmployee As Long Dim NumberMonth As Integer Dim Salary As Double NumberEmployee = Application.InputBox(prompt:="أدخل رقم الموظف", Title:="رقم الموظف", Type:=1) NumberMonth = Application.InputBox(prompt:="أدخل رقم الشهر", Title:="رقم الشهر", Type:=1) Salary = Application.InputBox(prompt:="أدخل قيمة الراتب", Title:="الراتب", Type:=1) If NumberEmployee = False Or NumberMonth = False Or Salary = False Then Exit Sub ElseIf NumberEmployee < 10 Or NumberEmployee > 15 Then MsgBox prompt:="رقم الموظف يجب أن يكون أكبر أو يساوي 10 و أصغر أو يساوي 15", Title:="خطأ" Exit Sub ElseIf NumberMonth <> Sheets("Sheet1").Range("B2").Value Then MsgBox prompt:="رقم الشهر يجب أن يساوي الرقم الموجود في الخلية B2", Title:="خطأ" Exit Sub ElseIf Salary <> 100 And Salary <> 200 Then MsgBox prompt:=" الراتب يجب أن يكون إما 100 أو 200", Title:="خطأ" Exit Sub Else Set VMonth = Sheets("Sheet1").Range("A1:N1").Find(NumberMonth) Set Employee = Sheets("Sheet1").Range("A1:A100").Find(NumberEmployee) Sheets("Sheet1").Cells(Employee.Row, VMonth.Column).Value = Salary End If End Sub

السلام عليكم ... توضيح للسائل : كلام الأخ العزيز أبو مؤنس صحيح في حال عدم اختيارك "نسخ الارتباط"

السلام عليكم ... الملف محمي ولكن بدون كلمة سر !!! حاول فك حماية الورقة فقط

السلام عليكم ... الكود هو التالي : Sub MoveValue() Dim EndRow As Long For i = 2 To 4 EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count Sheets(i).Cells(EndRow + 1, 1).Value = EndRow Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(i + 3, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(i + 3, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(i + 3, 4).Value Next i Sheets(1).Range("B1:B2,B5:D7").ClearContents End Sub وهذا شرح سريع لها : Dim EndRow As Long في السطر السابق عرفنا متغير EndRow من نوع Long بعدها توجد حلقة تكرارية تسند في كل دورة قيمة من 2 إلى 4 (و التي تمثل ترتيب الأوراق A و B و C) في المتغير i ، و الهدف من الحلقة التكرارية تقليص حجم الكود . EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count هنا نسند في المتغير EndRow رقم آخر سطر في ورقة الصنف ذات الترتيب i. Sheets(i).Cells(EndRow + 1, 1).Value = EndRow هنا ندرج الرقم في خلايا العامود "مسلسل". Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(i + 3, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(i + 3, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(i + 3, 4).Value هنا عملية مناقلة للخلايا بين الورقتين. Sheets(1).Range("B1:B2,B5:D7").ClearContents هنا نمسح في آخر الكود قيم الخلايا الموجودة في النموذج الأصلي.

السلام عليكم ... نزولاً عند طلب الأخ فلسطيني سوف أشرح الصيغة التالية : =INDIRECT(ADDRESS(1;MAX(IF(LARGE(C3:M3;COLUMN()-13)=C3:M3;COLUMN(C3:M3);0)))) الصيغة السابقة هي صيغة صفيف (أي يجب عند الإدخال الضغط على Ctrl+Shift+Enter) سوف أشرح أولاً الدوال المستخدمة في صيغة الصفيف هذه : - الدالة INDIRECT : تقوم بإرجاع المرجع المحدد بسلسة نصية تمثل عنوانه. - الدالة ADDRESS : تقوم بإنشاء عنوان لمرجع محدد بالاعتماد على رقم صف وعامود المرجع. - الدالة MAX : تقوم بإرجاع أكبر قيمة من مجموعة قيم عددية. - الدالة LARGE : تحدد أكبر قيمة من مجموعة قيم عددية وذلك مع تحديد الرتبة (أول أكبر قيمة ، أو ثاني أكبر قيمة ، أو....الخ). - الدالة COLUMN : ترجع ترتيب العامود لمرجع محدد ، وإذا كان القوسين بعدها فارغين () فترجع ترتيب العامود للخلية التي تحتوي على الصيغة الحالية. - الدالة IF الغنية عن التعريف. شرح الأجزاء : IF(LARGE(C3:M3;COLUMN()-13)=C3:M3;COLUMN(C3:M3);0) فحص كل خلية من المجال C3:M3 فإذا كانت أول أكبر قيمة (في حالة الصيغة الموجودة في العامود N) مساوية لقيمة الخلية فيتمم هنا إرجاع ترتيب عامود هذه الخلية وإلا فيتم إرجاع الرقم 0 الجزء السابق سوف ينتج عنه سلسة من الأصفار ورقم عامود أكبر خلية ، وبالتعليمة MAX نستخلص رقم عامود أكبر خلية . بعدها تقوم التعليمة ADDRESS بإرجاع عنوان الخلية الموجودة في الصف الأول (الموجود فيه الأشهر) و العامود صاحب الرقم الناتج عن الجزء السابق ، أي يتم إرجاع عنوان الخلية التي تحتوي على الشهر المقابل لأول أكبر قيمة من المجال C3:M3 (هذا طبعاً إذا كانت الصيغة موجودة في العامود N). تقوم التعليمة INDIRECT بعرض محتويات الخلية ذات العنوان الناتج عن الجزء السابق. هذا ولفهم صيغة الصفيف بشكل جيد أنصحك باستخدام الخيار Evaluate Formula من القائمة Tools القائمة الفرعية Formula Auditing.