أريد طريقة لجبر رقم معين إلى رقم آخر فى باستخدام الماوس

[أبــــو آيــــة]

أريد طريقة لجبر رقم معين إلى رقم آخر باستخدام الماوس (دبل كليك مثلا)..

مثلا لجبر طالب فى مادة معينة ليصل إلى درجة النجاح (مثلا الدرجة الحاصل عليها هى 40 ونريد جبره إلى 50) مع ملاحظة أنى أريد وضع حد أقصى لدرجات الجبر بـ 10 درجات (على سبيل المثال أى أن الطالب الذى يحصل على 39 درجة لا يمكن جبره إلى 50 وهكذا)....

أما الطالب الذى يحصل على درجة أقل من 48 وأكثر من 39 يتم جبره إلى 50...

[أم عبد الله]

السلام عليكم ورحمة الله وبركاته

 

أرجو  أن ترسل ملف للعمل عليه ادق وأسرع. عموماً جرب هذا الملف لعله المطلوب.

A1.rar

[سليم حاصبيا]

 السلام عليكم 

اليك المطلوب حسب ما فهمت من المشاركة

اضافة علامة.rar

[أبــــو آيــــة]

بارك الله فى كلا من الأخت الفاضلة/ أم عبدالله والأخ الفاضل/ سليم.. جزاكم الله خيرا على اهتمامكم وردكم

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

ولكن لى طلب آخر لو تفضلى على به يا أختى الكريمة ، وهو توضيح كيفية عمل ذلك لأنى لا اعرف كيف أنفذه على الملف المطلوب (وهو عبارة عن كنترول شيت لرصد درجات الطلاب)

أريد شرح لكيفية تنفيذ ذلك العمل..

وجزاكى الله عنا خير الجزاء.....

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

الأخ الحبيب السائل

ببساطة اعمل كليك يمين على كلمة ورقة 1 ثم View Code ليظهر لك مفتاح الحل الذي تفضلت به الأخت الكريمة أم عبد الله

قم فقط بنسخ الكود في الورقة المطلوب العمل عليها

وغير النطاق إلى النطاق الذي ترغبه (بس خلااااااااااص)

[أبــــو آيــــة]

 

الأخ الحبيب السائل

ببساطة اعمل كليك يمين على كلمة ورقة 1 ثم View Code ليظهر لك مفتاح الحل الذي تفضلت به الأخت الكريمة أم عبد الله

قم فقط بنسخ الكود في الورقة المطلوب العمل عليها

وغير النطاق إلى النطاق الذي ترغبه (بس خلااااااااااص)

 

بارك الله فيك أخى العزيز وزادك علماً ونفع بك ... واعتذر من سؤالى الذى يبدوا بسيطا ولكن هذا لأنى ليس لدى خبرة فى هذا المجال (الأكواد).. وشكرا على اهتمامك..

[أبــــو آيــــة]

السلام عليكم ورحمة الله وبركاته

 

أرجو  أن ترسل ملف للعمل عليه ادق وأسرع. عموماً جرب هذا الملف لعله المطلوب.

الأخت الفاضلة أم عبدالله/ بارك الله فيكى لقد كان فى ردك إجابة لما هو مطلوب ولكن يبقى جزء صغير وهو تعديل الكود ليشمل عدد من النطاقات كالتالى (E8:U8/E18:U18/E28:U28/E38:U38 وهكذا...) ليشمل أي عدد من النطاقات غير المتجاورة...

وجزاكم الله خيرا وزادكم علماً....

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

 

السلام عليكم ورحمة الله وبركاته

 

أرجو  أن ترسل ملف للعمل عليه ادق وأسرع. عموماً جرب هذا الملف لعله المطلوب.

الأخت الفاضلة أم عبدالله/ بارك الله فيكى لقد كان فى ردك إجابة لما هو مطلوب ولكن يبقى جزء صغير وهو تعديل الكود ليشمل عدد من النطاقات كالتالى (E8:U8/E18:U18/E28:U28/E38:U38 وهكذا...) ليشمل أي عدد من النطاقات غير المتجاورة...

وجزاكم الله خيرا وزادكم علماً....

 

تفضل أخي تعديل بسيط على الكود ليشمل المطلوب ، في السطر الأول اكتب ما تريد من النطاقات

A1.rar

[أم عبد الله]

الأستاذ / AABOAYA2

 

السلام عليكم ورحمة الله وبركاته

 

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

جبر رقم في مدى معين.rar

[أبــــو آيــــة]

الأستاذة الفاضلة/ أم عبدالله... والأستاذ الفاضل/ ياسر

جزاكم الله عنى خير الجزاء وبارك فيكما وزادكم علما ونفع بكم وجعل كل مجهوداتكم فى ميزان حسناتكم وجعل مجهودكم بمثابة العمل الصالح الذى ينفعكما إن شاء الله فى الدنيا والآخر...

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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set UnionRange = Union(Range("E8:U8"), Range("E18:U18"), Range("E28:U28"), Range("E38:U38"), Range("E48:U48"), Range("E65:U65"), Range("E75:U75"), Range("E85:U85"), Range("E95:U95"), Range("E105:U105"), Range("E122:U122"), Range("E132:U132"), Range("E142:U142"), Range("E152:U152"), Range("E162:U162"), Range("E179:U179"), Range("E189:U189"), Range("E199:U199"), Range("E209:U209"), Range("E219:U219"), Range("E236:U236"), Range("E246:U246"), Range("E256:U256"), Range("E266:U266"), Range("E276:U276"), Range("E293:U293"), Range("E303:U303"), Range("E313:U313"), Range("E323:U323"), Range("E333:U333"), Range("E350:U350"), Range("E360:U360"), Range("E370:U370"), Range("E380:U380"), Range("E390:U390"), Range("E407:U407"), Range("E417:U417"), Range("E427:U427"), Range("E437:U437"), Range("E447:U447"), Range("E464:U464"), Range("E474:U474"), Range("E484:U484"), Range("E494:U494"), Range("E504:U504"), Range("E521:U521"), Range("E531:U531"), Range("E541:U541"), Range("E551:U551"), Range("E561:U561"))

If Not Intersect(Target, UnionRange) Is Nothing Then
    If Target.Value >= "40" And Target.Value < "50" Then
    Cancel = True
    Target.Value = "50"
    Else
    Cancel = False
    
    End If
End If
End Sub

 

نموذج كنترول شيت1.rar

تم تعديل أكتوبر 27, 2014 بواسطه AABOAYA2

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

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

إن شاء الله نجد حل

تم تعديل أكتوبر 27, 2014 بواسطه YasserKhalil

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

جرب الكود بالشكل التالي:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set UnionRange = Union(Range("E8:U8,E18:U18,E28:U28,E38:U38,E48:U48,E65:U65,E75:U75,E85:U85,E95:U95"), _
               Range("E105:U105,E122:U122,E132:U132,E142:U142,E152:U152,E162:U162,E179:U179"), _
               Range("E189:U189,E199:U199,E209:U209,E219:U219,E236:U236,E246:U246,E256:U256"), _
               Range("E266:U266,E276:U276,E293:U293,E303:U303,E313:U313,E323:U323,E333:U333"), _
               Range("E350:U350,E360:U360,E370:U370,E380:U380,E390:U390,E407:U407,E417:U417"), _
               Range("E427:U427,E437:U437,E447:U447,E464:U464,E474:U474,E484:U484,E494:U494"), _
               Range("E504:U504,E521:U521,E531:U531,E541:U541,E551:U551,E561:U561"))

    If Not Intersect(Target, UnionRange) Is Nothing Then
        If Target.Value >= "40" And Target.Value < "50" Then
        Cancel = True
        Target.Value = "50"
        Else
        Cancel = False
        
        End If
    End If
End Sub

[أبــــو آيــــة]

أستاذنا الكبير/ ياسر

والله لا أجد الكلمات الكافية التى تعبر عن مدى إعجابى وامتنانى وتقديرى واحترامى لكم.

وكل ما استطيع فعله هو أن أدعو لك بظهر الغيب لعلها تكون دعوة مستجابة إن شاء الله  (كما علمنا حبيبنا المصطفى صلى الله عليه وسلم)

أن يوفقك دائما لكل ما هو خير لك وأن يرزقك خيرى الدنيا والآخرة...

وأن يبارك فيك وفى علمك وينفع بك دائما ويجعل كل مجهوداتك فى ميزان حسناتك...

مع خالص شكرى وتقديرى لك وللفاضلة/ أم عبدالله على تعبكم واهتمامكم بخصوص هذا الموضوع...

وأرجوا إن شاء الله أن يتسع لى صدركم كلما اتيحت لى الفرصة لكى أنهل من بحر علمكم الوافر (بارك الله فيه)....

والسلام عليكم ورحمة الله وبركاته،،،

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

الأخ الفاضل أشكرك على كلماتك الرقيقة ودعائك لي بظهر الغيب ..

جمعنا الله وإياكم في الفردوس الأعلى .. قولوا آمين

[أبــــو آيــــة]

أستاذنا العزيز/ يــاســـر

أعرف أنى أثقلت عليك ولكنى أرجــو مـن حضرتك  عمل إضافة للكود أو إنشاء كود آخر مع تعديل النطاقات والأرقام...

بمعنى أنى أريد كود آخر لنطاق آخر ضمن نفس الملف الموجود به الكود السابق ولكن مع تغيير النطاق والأرقام كالتالى {K7:L7 / K17:L17.... وهكذا كما فى الكود السابق ، وتعديل الأرقام لتكون 25 بدلا من 50 ،،، و 20 بدلا من 40}

ومرفق لحضرتك نموذج يوضح المطلوب بالضبط

نموذج كنترول شيت2.rar

[أبــــو آيــــة]

أستاذنا العزيز/ يــاســـر

أعرف أنى أثقلت عليك ولكنى أرجــو مـن حضرتك  عمل إضافة للكود أو إنشاء كود آخر مع تعديل النطاقات والأرقام...

بمعنى أنى أريد كود آخر لنطاق آخر ضمن نفس الملف الموجود به الكود السابق ولكن مع تغيير النطاق والأرقام كالتالى {K7:L7 / K17:L17.... وهكذا كما فى الكود السابق ، وتعديل الأرقام لتكون 25 بدلا من 50 ،،، و 20 بدلا من 40}

ومرفق لحضرتك نموذج يوضح المطلوب بالضبط

مع العلم بأننى قمت بنسخ نفس الكود وعدلت النطاقات والأرقام ولكن كلا الكودين لم يعملا... وبعد ما قمت بعمل حذف للكود الثانى عاد الكود الأول للعمل من جديد...

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

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

لا تهرب من مشكلتك بالحلول السريعة (تاخد السمكة وتجري) حاول وافشل يكفيك شرف المحاولة

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

[أبــــو آيــــة]

أستاذنا القدير/ يـــاســـــر

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

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

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

مع خالص شكرى وتقدير لحضرتك،،،

نموذج كنترول شيت2.rar

تم تعديل أكتوبر 28, 2014 بواسطه AABOAYA2

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

تفضل أخي الحبيب أبو آية

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set UnionRange1 = Union(Range("E5:U5,E8:U8,E11:U11,E14:U14,E17:U17,E20:U20,E23:U23,E26:U26,E29:U29"), _
               Range("E32:U32,E35:U35,E38:U38,E41:U41,E44:U44,E47:U47,E50:U50"), _
               Range("E53:U53,E56:U56,E59:U59,E62:U62,E65:U65,E68:U68,E71:U71"), _
               Range("E74:U74,E77:U77,E80:U80,E83:U83,E86:U86,E89:U89,E92:U92"), _
               Range("E95:U95,E98:U98,E101:U101,E104:U104,E107:U107,E110:U110,E113:U113"), _
               Range("E116:U116,E119:U119,E122:U122,E125:U125,E128:U128,E131:U131,E134:U134"), _
               Range("E137:U137,E140:U140,E143:U143,E146:U146,E149:U149,E152:U152"))

    If Not Intersect(Target, UnionRange1) Is Nothing Then
        If Target.Value >= "40" And Target.Value < "50" Then
        Cancel = True
        Target.Value = "50"
        Else
        Cancel = False
        
        End If
    End If
    
    Set UnionRange2 = Union(Range("J3:U3,J6:U6,J9:U9,J12:U12,J15:U15,J18:U18,J21:U21,J24:U24,J27:U27"), _
               Range("J30:K30,J33:K33,J36:K36,J39:K39,J42:K42,J45:K45,J48:K48"), _
               Range("J51:K51,J54:K54,J57:K57,J60:K60,J63:K63,J66:K66,J69:K69"), _
               Range("J72:K72,J75:K75,J78:K78,J81:K81,J84:K84,J87:K87,J90:K90"), _
               Range("J93:K93,J96:K96,J99:K99,J102:K102,J105:K105,J108:K108,J111:K111"), _
               Range("J114:K114,J117:K117,J120:K120,J123:K123,J126:K126,J129:K129,J132:K132"), _
               Range("J135:K135,J138:K138,J141:K141,J144:K144,J147:K147,J150:K150"))

    If Not Intersect(Target, UnionRange2) Is Nothing Then
        If Target.Value >= "20" And Target.Value < "25" Then
        Cancel = True
        Target.Value = "25"
        Else
        Cancel = False
        
        End If
    End If
 
    
End Sub

[أبــــو آيــــة]

أسـتـاذنـا العـزيـز/ يــاســــر

جزاك الله خير الجزاء، لقد تم إنـجاز المـطـلوب، على أكمل وجه.

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

وكذلك الشكر موصول للسيدة الفاضلة القديرة/ أم عبدالله..

بارك الله فيكم ونفع بكم وجعل عملكم فى ميزان حسناتكم إن شاء الله..

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

والسلام عليكم ورحمة الله وبركاته،،،

[Mohamed Khaled - Nawras]

ممكن ترسلي الملف على الاميل ده والحل عندي ان شاء الله.

Contabl2006@hotmail.com