علي السحيب

تم إضافة جميع التعديلات المطلوبة .. والصيغة التالية هي لإستخراج بيانات المتدربين من ثلاث جدوال متفرقة: =IF(AND(ISNA(VLOOKUP($B$1,الإلكترونيات!essai,2,0)),ISNA(VLOOKUP($B$1,تمديدات!essai,2,0)),ISNA(VLOOKUP($B$1,تركيبات!essai,2,0))),"لا يوجد بيانات تحت هذا الرقم",IF(AND(ISNA(VLOOKUP($B$1,الإلكترونيات!essai,2,0)),ISNA(VLOOKUP($B$1,تمديدات!essai,2,0))),VLOOKUP($B$1,تركيبات!essai,2,0),IF(AND(ISNA(VLOOKUP($B$1,تركيبات!essai,2,0)),ISNA(VLOOKUP($B$1,تمديدات!essai,2,0))),VLOOKUP($B$1,الإلكترونيات!essai,2,0),IF(AND(ISNA(VLOOKUP($B$1,تركيبات!essai,2,0)),ISNA(VLOOKUP($B$1,الإلكترونيات!essai,2,0))),VLOOKUP($B$1,تمديدات!essai,2,0))))) أما الصيغة التالية فهي لإستخراج عدد المتدربين في كل ولاية من ثلاث جدوال متفرقة: =COUNTIF(الإلكترونيات!$H$12:$H$33,الولايات!B13)+COUNTIF(تمديدات!$H$7:$H$36,الولايات!B13)+COUNTIF(تركيبات!$H$13:$H$39,الولايات!B13) شاهد المرفق، ______.rar

أعتقد أن المطوب هو إزالة علامة الدولار $ لتصبح الصيغة مطلقة وغير محصورة في الخلية D3 فقط.

حاولت إستخراج رقم الشهر الموجود في التاريخ المُدخل عن طريق هذه الالة فظهر لي الخطاً #VALUE! .. لذا أضطررت إلى إستبدال الصيغة المذكورة بالدالة NOW .. واجهت أيضاً بعض الصعوبات في تنسيق الصيغة التي تجمع الدوال Time و Date .. لذا رأيت من الأفضل إستبدالها بالدالة NOW.. والغريب أنني عندما جربت الطريقتين في ملف آخر .. كلاهما عمل بشكل صحيح من ناحية إستخراج رقم الشهر ومن ناحية التنسيق أيضاً .. لا أدري لماذا!!! مرفق مثال على كل حال .. تم إضافة جميع التعديلات المطلوبة .. شاهد المرفق، _________________________.rar _____________________________.rar

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

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

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

يتم ذلك عن طريق الدالة TODAY: ضع الصيغة التالية في الخلية المُراد خروج التاريخ فيها : =TODAY() وإذا كنت تريد خروج التاريخ والوقت معاً .. ضع الصيغة التالية: =NOW()

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

تم إضافة جميع ما ذكر في المرفق وزيادة ( لاحظ كيف يتم إضافة التعليقات التي تحتوي على أسماء العملاء) ______________________.rar

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

في الصيغ الرياضية والأكواد .. عندما نستخدم الكلمات أوالرموز (ما عدا الأرقام) يجب تطويقها بعلامات تنصيص .. كهذا السطر مثلاً: If ComboBox1 = "يوليو" Then Sheet7.Activate لاحظ أننا وضعنا علامتي تنصيص في بداية ونهاية الكلمة يوليو. أتمنى أن يكون هذا واضحاً:

يتم ذلك عن طريق كتابة كود برمجي لتنفيذ المهمة التي تريد .. ومن ثم ربط العنصر بالكود عن طريق الضغط على العنصر بالزر الأيمن وإختيار (تعيين ماكرو) .. ثم إختيار الكود المُراد ربطه بالعنصر والضغط على موافق.

راجع الروابط التالية: http://www.officena.net/ib/index.php?showtopic=25 http://www.officena.net/ib/index.php?showtopic=4393 http://www.officena.net/ib/index.php?showtopic=2813

الكود التالي ينفذ ما تريد، Sub MovingTo2Sheets() Beep A = MsgBox("سيتم نقل بيانات الصفحة الثالثة إلى الثانية وبيانات الصفحة الأولى إلى الثانية .. فهل تريد المتابعة؟", vbQuestion + vbYesNo, "تأكيد") If A = vbYes Then Sheet3.[D8:K26].ClearContents For R = 8 To 26 With Sheet3.Columns(4).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet2.Cells(R, 4) .Offset(1, 1) = Sheet2.Cells(R, 5) .Offset(1, 2) = Sheet2.Cells(R, 6) .Offset(1, 3) = Sheet2.Cells(R, 7) .Offset(1, 4) = Sheet2.Cells(R, 8) .Offset(1, 5) = Sheet2.Cells(R, 9) .Offset(1, 6) = Sheet2.Cells(R, 10) .Offset(1, 7) = Sheet2.Cells(R, 11) End With Next Sheet2.[D8:K26].ClearContents For R = 8 To 26 With Sheet2.Columns(4).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet1.Cells(R, 4) .Offset(1, 1) = Sheet1.Cells(R, 5) .Offset(1, 2) = Sheet1.Cells(R, 6) .Offset(1, 3) = Sheet1.Cells(R, 7) .Offset(1, 4) = Sheet1.Cells(R, 8) .Offset(1, 5) = Sheet1.Cells(R, 9) .Offset(1, 6) = Sheet1.Cells(R, 10) .Offset(1, 7) = Sheet1.Cells(R, 11) End With Next Sheet1.[D8:K26].ClearContents MsgBox "!تم ترحيل بيانات الصفحة الأولى والثانية بنجاح", vbInformation, "تم الترحيل" End If End Sub شاهد المرفق، ________________________________________________________________________.rar

المرفق التالي يتميز بإنشاء قائمة للمجاميع تتعبأ بشكل تلقائي وتحوي على الأسماء الموجودة في القائمة الرئيسة (وبدون تكرار) يعني أنه إذا تم إضافة مبلغ جديد يتم التالي: - عدم إمكانية إضافة المبلغ قبل اسم العميل. - إذا كان اسم الشخص الذي تم إضافة المبلغ الجديد عليه موجود مسبقاً في القائمة الرئيسة، فإنه يتم إضافة المبلغ فقط بجانب اسمه الموجود في قائمة المجاميع. - أما إذا كان اسم الشخص الذي تم إضافة المبلغ الجديد عليه غير موجود مسبقاً في القائمة الرئيسية، فإنه يتم إضافة الاسم الجديد والمبلغ في قائمة المجاميع. شاهد المرفق، ___________________________.rar

بالنسبة لعدد الصفوف التي تود ترحيلها .. فإني قد حددت في الكود فقط 300 صف .. ويمكنك تغيير هذا الرقم في الكود إلى أي رقم تشاء. لابد من تحديد إسم الورقة التي تريد نقل البيانات إليها .. فلا مانع من أن تضع ورقة معينة في نهاية أوراق العمل .. وتشير إليها في الكود ليتم الترحيل إليها .. وللمعلومية فإن إسم الورقة التي أشرت أنا إ ليها هي Sheet2 .. يمكنك تغيير هذا الإسم إلى إسم الورقة التي تريد.

جميع التعديلات التي قمت بها صحيحة .. ماعدا هذا السطر .. Cells(A, B) = Cells(6, e) لا أدري من أي جئب بحرف e .. كان يجب أن تضع بدلاً منه حرف B .. والذي يمثل في الكود أرقام الأعمدة التي سيتم الترحيل إليها. أما بالنسبة للسطر الذي ذكرت (If Err = 1004 Then) فهو يتم الرجوع إليه وأخذ نتائجة عند حدوث خطأ في تطبيق الكود.. والخطأ في هذا الكود يظهر عندما لا يكون هناك رقم في العمود مساوٍ للرقم الذي كتبته في الخلية E6. كل ما عليك فعله الآن هو تغيير حرف e إلى B .. وسيصبح كل شيء على ما يرام بإذن الله.

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

الرابط التالي يحتوي على شرح وافي لما تريد، http://www.officena.net/ib/index.php?showtopic=13038

نعم أنت على حق .. ولكني أحبب إثراء هذا الموضوع .. ولم أنته إلى إحتماليه تكرار الصفر أكثر من مره في الرقم. شكراً على ملاحظتك.

الكود التالي يلبي طلبك: Sub moving() Sheet2.[A2:F500].ClearContents For R = 2 To 300 If Cells(R, 2) <> "" And Cells(R, 1).Row Mod 2 = 0 Then With Sheet2.Columns(1).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 1) .Offset(1, 1) = Cells(R, 2) .Offset(1, 2) = Cells(R, 3) End With End If Next For R = 2 To 300 If Cells(R, 2) <> "" And Cells(R, 1).Row Mod 2 = 1 Then With Sheet2.Columns(4).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 1) .Offset(1, 1) = Cells(R, 2) .Offset(1, 2) = Cells(R, 3) End With End If Next MsgBox "!تم ترحيل البيانات إلى الصفحة الثانية بنجاح", vbInformation, "تم الترحيل" End Sub شاهد المرفق، __________________________________.rar

يمكننا أيضاً إستخدام الدالة SUBSTITUE .. وهي أسهل في الإستخدام. =SUBSTITUTE(E4,0,966) ويمكننا أيضاً إختصار الصيغة عند إستخدام الدالة REPLACE .. لتصبح: =REPLACE(E4,1,1,966) شاهد المرفق، ______________.rar

أعتقد أن الكود التالي أكثر كفاءة: Private Sub Worksheet_Change(ByVal Target As Range) TR = Target.Row TC = Target.Column If TR > 2 And (TC = 3 Or TC = 4) And Cells(TR, 5) < 1 Then MsgBox "!مبلغ صافي الراتب أقل من أو يساوي صفر", vbExclamation, "تنبيه" End If End Sub شاهد المرفق، _________________________________________.rar

فقط نقوم بإضافة إسم الصفحة التي يوجد بها البيانات (Sheet2) قبل أرقام الخلايا التي سوف يتم جلب البيانات منها .. فيصبح الكود كالتالي: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$9" Then A = Application.WorksheetFunction.Match(1, Sheet2.[A3:A7], 0) + 2 B = Application.WorksheetFunction.Match(6, Sheet2.[A3:A7], 0) + 2 C = Application.WorksheetFunction.Match(4, Sheet2.[A3:A7], 0) + 2 D = Application.WorksheetFunction.Match(2, Sheet2.[A3:A7], 0) + 2 E = Application.WorksheetFunction.Match(3, Sheet2.[A3:A7], 0) + 2 [A13:J16].ClearContents If [A9] = "" Then Exit Sub If [A9] = 8 Then For F = 1 To 10 Cells(13, F) = Sheet2.Cells(A, F) Cells(14, F) = Sheet2.Cells(B, F) Cells(15, F) = Sheet2.Cells(C, F) Next Else: For F = 1 To 10 Cells(13, F) = Sheet2.Cells(A, F) Cells(14, F) = Sheet2.Cells(D, F) Cells(15, F) = Sheet2.Cells(E, F) Cells(16, F) = Sheet2.Cells(C, F) Next End If End If End Sub شاهد المرفق، وشاهد أيضاً التعديل الذي طلبت على هذا الموضوع: http://www.officena.net/ib/index.php?showtopic=13905 _______________.rar

شاهد المرفق، ________.rar