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

تم فصل الموضوع للفائدة ==== وهذا رابط موضوع لنفس الطلب للاستاذ عادل حنفي الرابط هنا

ضع هذا الكود في حدث اي ورقة تريد Private Sub Worksheet_Activate() Range("A1").Select End Sub

السلام عليكم ارجو منك اخي ذيب اليمن التوضيح أكثر (هل تريد استبدال الدالة VLOOKUP بالكود)

السلام عليكم لشكر لك كلامك الجميل ولا يهمك استبدل الكود السابق بهذا Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 37 Then Exit Sub If Target.Column <> 3 Then Exit Sub Range("F4:F34").ClearContents Dim cl As Range Set xx = Application.WorksheetFunction r = Range("C37").Value For Each cl In Range("F4:F34") If cl.Interior.ColorIndex <> xlNone Then GoTo 1 LR = Range("f10000").End(xlUp).Row w = xx.Sum(Range("F4:F" & LR)) If w <= r And cl.Interior.ColorIndex = xlNone Then cl.Value = 2 If r - w = 1 Then Cells(cl.Row, 6).Value = 1 If w = r Or w + 1 = r Then Exit Sub End If If w > r Then Exit Sub 1 Next cl End Sub

الاستاذ الفاضل يحيى حسين نيابة عني وعن الاستاذ عماد اشكرك جزيل الشكر على التهنئة ابواحمد

السلام عليكم تفضل المرفق سيتم التوزيع بعد وضع الرقم في الخلية توزيع.rar

لا اقول الا مثل ما قاله ابو عبدالرحمن

السلام عليكم بارك الله فيك استاذ بن عليه المشكلة ان الاخ السائل اشترط معادلات

تم عمل اللازم اخي حسام

كما قال ابو العبادي والمثل يقول الاختلاف في الراي لا يفسد للود قضية === حياك الله اخي ايهاب

ماشاء الله اعمالك دائماً مميزة استاذ محمد يحياوي بارك الله فيك

السلام عليكم اولاً احيي الجميع على تفاعلهم في الموضوع وكما قال عميدنا ان الكل على حق في ما يراه ===== توضيح للاخ ايهاب ((ما يفهم من رد الاستاذ يحياوي انه لا يوجد اي تناقض بل هو من المؤيدين لفك الحماية عن الملفات)) اما بخصوص توضيحي لما اراه فهو كالتالي: الملفات ثلاثة انوع نوع قام به احد الاساتذة مثل اعمال الاستاذ الحسامي ووضع باسوورد على محرر الاكواد فهنا ينظر الى العمل على انه عمل خيري والغرض الفائدة منه لذا يمكن ان عرف المصدر ان تتم مخاطبته لاخذ الاذن والا يمكن المساعدة للفائدة النوع الثاني هو مشابه للاول ولكن صاحبة وضع رسالة تحذيرية من فتح الملف فهنا ارى ان تم المساعدة فهو انتهاك صارخ لحق صاحب العمل في ضمان عدم الاطلاع على ما قام به النوع الثالث ملفات العمل الخاصة وهذا ما كنت اقصده بالذات فمثلاً انا اقوم بعمل اكواد تساعد في عملي وبرامج واضع باسوورد للعمل لضمان الحفاظ على جهدي وعدم السطو عليه والادعاء بان من قام بالسطو هو من قام بالعمل لمجرد تغيير اسم ميكرو او غيرها فمثل هذا الملف لو رفع على المنتدى وتم كسر حماية المحرر فقد انتهكنا حق صاحب العمل هذا هو مجمل رايي في الموضوع ================================================================ ساجيب عن اسئلة الاخ ايهاب لا فرق بين الاثنين فلو كانت الحماية على الملف او كانت على المحرر فالحال والراي واحد في الحالتين من محتوى العمل فاعتقد ان من يريد حماية حقوقه فانه يضع بصمته في الكود هذه من النوع الاول من الملفات ================= وشكراً للجميع واخص شكري للاستاذ محمد يحياوي ابو احمد

السلام عليكم نرجو منك التحلي بالصبر ============ اخي الفاضل هل اطلعت على المرفق في مشاركتي الاخيرة (تم الاستغناء عن العمود المساعد) ========= بانتظار الرد حتى يتم تحديد اين سيتم التعديل توفيراً للجهد

ههههههههههههه ======= لا شكر على واجب

السلام عليكم كنت قد قرات في مشاركتك قبل التعديل طلبك بالغاء العمود المساعد تفضل المرفق ستقوم بتلوين خلية الغياب باللون الاصفر ثم تضغط الزر وسيتم التوزيع ======= اخي ابو نصار شكراً لمرورك توزيع.rar

السلام عليكم ما رايك في حل بالاكواد جرب المرفق توزيع.rar

الاستاذ الوقور المبدع " نارت لبزو " مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي Mhrrd مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي احمد فضيلة مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي محارب الصخراء يحياوي مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي سعيد بيرم مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي نادر مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع اخي احمد حمور مبارك علينا وعليكم وبارك الله فيك على هذا التشجيع وان شاء الرحمن ان نكون انا واخي ابو العبادي عند حسن الظن

ضع هذه المعادلة في خانة الايراد =C8-FLOOR(C8;0.05) وهذه في خانة الصافي المستحق =FLOOR(C8;0.05) ولاحظ النتيجة

ضع هذه المعادلة في الخلية المحددة باللون البرتغالي =VLOOKUP(I8;A1:B17;2;0) والله الموفق

السلام عليكم ابا ادم الكود كان ينقصه الاسم Sub hosami() Dim rng As Range On Error Resume Next Set rng = Range([a1], Cells(Range("a65536").End(xlUp).Row, 1)) For i = 1 To rng.Rows.Count If rng.Cells(i, 1) <> rng.Cells(i - 1, 1) + 1 Then _ Range("b1000").End(xlUp).Offset(1, 0) = rng.Cells(i - 1, 1) + 1 Next i End Sub جربه الان

الاستاذ سعد عابد الاستاذ هشام شلبي غمرتونا بكرم اخلاقكم شكراً لكم على الدعم والتشجيع ابواحمد

السلام عليكم مبدئياً العمود الذي يحتوي على اسماء الشيتات المراد ترحيل البيانات اليها هو العمود A ويبداء من الصف الثاني

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

ضع هذه المعادلة في الخلية G6 واسحبها للاسفل =IF(F6="معلم ";E6*50%;IF(F6="معلم اول ";E6*70%;IF(F6="معلم اول أ";E6*100%)))

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