ياسر خليل أبو البراء

بارك الله فيك أخي الحبيب زيزو .. كم تعجبني مشاركاتك وعملك في صمت جزاك الله كل خير

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

وعليكم السلام الموضوع كلمتين وبس ..دا مياكلش معانا لازم تفاصيل يا حاج أحمد وبعدين الصور الموجودة في المرفق 5 صور وإنت بتقول 36 .. والعرض هيكون فين :: ايه هي آلية العمل؟ هل الصور مطلوب إدراجها في الشيت ولا في الفورم فقط ... لو أرفقت نموذج مصغر يكون أفضل عشان الأمور تكون أوضح .. ولو تقدر تقولنا على شكل النتائج المتوقعة يبقا كدا عداك العيب وأزح (قزح في اللغة العربية : تعني وثب وثبة طويلة) تقبل تحياتي

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

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

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

موضوع مكرر .. التكرار لا يفيد في المنتدى !! أكد عملية الحذف ليتم الحذف أخي الكريم محمد

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

لا أدري ما المشكلة بالضبط لديك فالأمر غير واضخ تماماً .. عموماً حسب ما فهمت جرب الكود التالي عله يفي بالغرض (ولا داعي لاستخدام التحقق من الصحة في هذه الحالة) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Target.Row > 16 And Target.Column = 7 Then Dim lr As Long, x As Long, y As Variant y = Target.Value lr = Cells(Rows.Count, Target.Column).End(xlUp).Row Application.EnableEvents = False x = Application.WorksheetFunction.CountIf(Range("G17:G" & lr), y) If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Target.Value = "": GoTo Skipper If x > 50 Or y < 1 Or y > 10 Then MsgBox "انتبه . الرقم " & Target.Value & " تجاوز العدد 50", vbExclamation: Target.Value = "" End If Skipper: Application.EnableEvents = True End Sub

وعليكم السلام أخي الكريم كريم (حلوة القافية) جرب الكود التالي .. عله يفي بالغرض Sub Test() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("معاشات استثنائية ") ws.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(Time, "hhmmss") ws.Activate ws.Range("F12:H36").ClearContents MsgBox "Done ...", 64 End Sub أعتقد أن الملف المرفق به تلف أو شيء ما مريب حيث تتجمد أوراق العمل .. عموماً حاول تجرب الكود وتشوف .. ولو فيه مشاكل أنشيء الملف من جديد أفضل تقبل تحياتي كشوف معاشات استثنائية.rar

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

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

وعليكم السلام يا ابن الملك جرب المعادلة التالية علها تفي بالغرض =SUMPRODUCT(($D$10:$D$60>=10100)*($D$10:$D$60<=10400)*(SUBTOTAL(103,OFFSET($D$10,ROW($D$10:$D$60)-MIN(ROW($D$10:$D$60)),0))))

استبدل كلمة CountLarge بكلمة Count ..حيث يبدو أن إصدار الأوفيس لديك قديم

جرب التعديل التالي ... Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 5 And Target.Column = 4 Then Dim lr As Long, x As Long, y As Variant y = Target.Value lr = Cells(Rows.Count, Target.Column).End(xlUp).Row x = Application.WorksheetFunction.CountIf(Range("D6:D" & lr), y) If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Exit Sub If x > 50 Or y < 1 Or y > 10 Then MsgBox "The Number " & Target.Value & " Exceeds 50", vbExclamation End If End Sub

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

السلام عليكم جرب الكود التالي في حدث ورقة العمل عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 5 And Target.Column = 4 Then Dim lr As Long, x As Long lr = Cells(Rows.Count, Target.Column).End(xlUp).Row x = Application.WorksheetFunction.CountIf(Range("D6:D" & lr), Target.Value) If x > 50 Then MsgBox "The Number " & Target.Value & " Exceeds 50", vbExclamation End If End Sub

أخي الكريم ياسر الأفضل طرح موضوع مستقل لكل طلب وإن شاء الله في أقرب وقت أحاول شرحه لك ..

أخي الكريم لم أقصد أن تغير الصورة .. فالأمر يرجع إليك بالنسبة للكود يمكنك تجربة الكود التالي Sub ClearRanges() Range("E3:E7").ClearContents Range("H9:J12").ClearContents End Sub للمزيد حول البدايات وكيفية وضع الأكواد شاهد الفيديو التالي

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

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

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

أخي العزيز أبو يوسف النقطة الأولى التي تخص CurrentRegion هي طريقة مختصرة .. تعادل طريقة الضغط على Ctrl + A إذا حددت أي خلية داخل النطاق وضغطت على Ctrl + A سيقوم بتحديد النطاق المطلوب بالكامل .. أو يمكنك الاعتماد على النطاق كما ذكرت بتحديد نقطة البداية ونقطة النهاية للنطاق arr=Range("A8:BE" & lr).Value النقطة الثانية ترحيل من A8 لأن النطاق الذي قمت بتخزينه يبدأ من A8 إذا أردت الترحيل من A1 قم بتغيير النطاق في سطر المصفوفة .. بالنسبة للورقة المرحل إليها .. ستجد أن آخر سطر في الكود هو المسئول عن ذلك وبالتالي يمكنك تغيير نقطة البداية لورقة النتائج من آخر سطر ضع الكود وملفك للإطلاع عليه (ضع نموذج مصغر) .. وضع ملاحظاتك لكي تتعلم ونستطيع أن نفيدك في الوقت ذاته

كود آخر أبسط بدلاً من استخدام الحلقات التكرارية Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Address = "$A$2" Then Dim c As Range Range("B3").Value = Target.Value With Range("C3:Z3") .Formula = "=MOD(B3,3)+1" .Value = .Value End With End If End Sub

في الجزء الثاني بعدعلامة بساوي استبدل كلمة Value بكلمة Row لتعرف رقم الصف .. وعلى أساسه قم بضبط -6 أو أي قيمة بحيث يكون التسلسل مصبوط ..هذا ما أقصده