اذهب الي المحتوي
أوفيسنا

مطلوب 1 تحويل معادلة إلى كود

يوسف عطا

بواسطه يوسف عطا
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

يوسف عطا

يوسف عطا

قام بنشر
قام بنشر

الرجاء المساعدة فى تحويل المعادلة الآتية المتكررة فى العمود K من الخلية K11 إلى الخلية K 2000


=IF(AND(I11="غ";J11="غ");"غ";SUM(I11:J11))

إلى كود يطبق فى نفس الخلايا المذكورة

علماً بأن المعادلة تتكرر فى 12 عمود آخر هم

K

P

V

AA

AG

AL

BT

BY

DG

DL

DR

DW

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

رابط هذا التعليق
شارك
أبو حنــــين

أبو حنــــين

قام بنشر
قام بنشر

جرب هذا الكود


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

For s = 1 To 2000 '00

    If Cells(s + 10, 9).Value = "غ" And Cells(s + 10, 10).Value = "غ" Then

	    Cells(s + 10, 11).Value = "غ"

		  Else

	    Cells(s + 10, 11).Value = Val(Cells(s + 10, 9).Value) + Val(Cells(s + 10, 10).Value)

	 If Cells(s + 10, 9).Value = "" And Cells(s + 10, 10).Value = "" Then Cells(s + 10, 11).Value = ""

    End If

Next

End Sub

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

الله ينور عليك يا ابو حنين

فعلاً كدة الكود قام بما تقوم به المعادلة فى 2000 صف

ولكن عندى إستفسارين

1. الملف يتم تحديثه كل جزء من ثانية أثناء الكتابة فتظل علامة التحديث أو التحميل الخاصة بالإيكسيل موجودة دائماً وكذلك تتأخر عملية إدخال الدرجات

كيف أتغلب على هذه النقطة

2. هل لتكرار نفس الكود فى أعمدة أخرى

أقوم بكتابة كود جديد مع تغيير أرقام الأعمدة ؟؟

أم تغيير المتغير s ؟

أم تغيير كلاهما ؟؟

أم إضافة أرقام الأعمدة الأخرى فى نفس الكود ؟؟؟

حيث حاولت ولم أفلح

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

11 و 16 و 22 و 27 و 33 و 38 و 72 و 77 و 111 و 116 و 122 و 127

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

غ + غ = غ

غ + رقم = الرقم

رقم + غ = الرقم

رقم + رقم = مجموعهما

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر (معدل)

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

ولكن مشكلة تحديث الصفحة بستمرار لا زالت تحتاج حل لأن كل كليك أو إنتقال لخلية تجعل علامة تحديث الصفحة تومض آلاف المرات فأضطر للإنتظار أكثر من دقيقة حتى أتمكن من وضع رقم آخر فى خلية أخرى

أرجو المساعدة فى حل المشكلة المذكورة

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


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

For K = 1 To 2000 '00

	    If Cells(K + 10, 9).Value = "غ" And Cells(K + 10, 10).Value = "غ" Then

			    Cells(A + 10, 11).Value = "غ"

				  Else

			    Cells(K + 10, 11).Value = Val(Cells(K + 10, 9).Value) + Val(Cells(K + 10, 10).Value)

	    If Cells(K + 10, 9).Value = "" And Cells(K + 10, 10).Value = "" Then Cells(K + 10, 11).Value = ""

	    End If

Next

For P = 1 To 2000 '00

	    If Cells(P + 10, 14).Value = "غ" And Cells(P + 10, 15).Value = "غ" Then

			    Cells(P + 10, 16).Value = "غ"

				  Else

			    Cells(P + 10, 16).Value = Val(Cells(P + 10, 14).Value) + Val(Cells(P + 10, 15).Value)

	    If Cells(P + 10, 14).Value = "" And Cells(P + 10, 15).Value = "" Then Cells(P + 10, 16).Value = ""

	    End If

Next

For V = 1 To 2000 '00

	    If Cells(V + 10, 20).Value = "غ" And Cells(V + 10, 21).Value = "غ" Then

			    Cells(V + 10, 22).Value = "غ"

				  Else

			    Cells(V + 10, 22).Value = Val(Cells(V + 10, 20).Value) + Val(Cells(V + 10, 21).Value)

	    If Cells(V + 10, 20).Value = "" And Cells(V + 10, 21).Value = "" Then Cells(V + 10, 22).Value = ""

	    End If

Next

For AA = 1 To 2000 '00

	    If Cells(AA + 10, 25).Value = "غ" And Cells(AA + 10, 26).Value = "غ" Then

			    Cells(AA + 10, 27).Value = "غ"

				  Else

			    Cells(AA + 10, 27).Value = Val(Cells(AA + 10, 25).Value) + Val(Cells(AA + 10, 26).Value)

	    If Cells(AA + 10, 25).Value = "" And Cells(AA + 10, 26).Value = "" Then Cells(AA + 10, 27).Value = ""

	    End If

Next

For AG = 1 To 2000 '00

	    If Cells(AG + 10, 31).Value = "غ" And Cells(AG + 10, 32).Value = "غ" Then

			    Cells(AG + 10, 33).Value = "غ"

				  Else

			    Cells(AG + 10, 33).Value = Val(Cells(AG + 10, 31).Value) + Val(Cells(AG + 10, 32).Value)

	    If Cells(AG + 10, 31).Value = "" And Cells(AG + 10, 32).Value = "" Then Cells(AG + 10, 33).Value = ""

	    End If

Next

For AL = 1 To 2000 '00

	    If Cells(AL + 10, 36).Value = "غ" And Cells(AL + 10, 37).Value = "غ" Then

			    Cells(AL + 10, 38).Value = "غ"

				  Else

			    Cells(AL + 10, 38).Value = Val(Cells(AL + 10, 36).Value) + Val(Cells(AL + 10, 37).Value)

	    If Cells(AL + 10, 36).Value = "" And Cells(AL + 10, 37).Value = "" Then Cells(AL + 10, 38).Value = ""

	    End If

Next

For BT = 1 To 2000 '00

	    If Cells(BT + 10, 70).Value = "غ" And Cells(BT + 10, 71).Value = "غ" Then

			    Cells(BT + 10, 72).Value = "غ"

				  Else

			    Cells(BT + 10, 72).Value = Val(Cells(BT + 10, 70).Value) + Val(Cells(BT + 10, 71).Value)

		 If Cells(BT + 10, 70).Value = "" And Cells(BT + 10, 71).Value = "" Then Cells(BT + 10, 72).Value = ""

	    End If

Next

End Sub

تم تعديل بواسطه يوسف عطا
رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

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


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

For s = 11 To 2000 '00

	    If Cells(s, 9).Value = "غ" And Cells(s , 10).Value = "غ" Then

			    Cells(s , 11).Value = "غ"

				  Else

			    Cells(s , 11).Value = Val(Cells(s, 9).Value) + Val(Cells(s , 10).Value)

		 If Cells(s , 9).Value = "" And Cells(s, 10).Value = "" Then Cells(s, 11).Value = ""

	    End If

Next

End Sub

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

السلام عليكم

تفضل

الكود في حدث الصفحه


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 9).End(xlUp).Row

For R = 11 To RR

   For TT = 1 To 12

    AC = Choose(TT, 9, 14, 20, 25, 31, 36, 70, 75, 109, 114, 120, 125)

	 AT = Choose(TT, 10, 15, 21, 26, 32, 37, 71, 76, 110, 115, 121, 126)

	  AD = Choose(TT, 11, 16, 22, 27, 33, 38, 72, 77, 111, 116, 122, 127)

	    If Cells(R, AC) = "غ" And Cells(R, AT) = "غ" Then

		    Cells(R, AD) = "غ"

			  Else

		    Cells(R, AD) = Val(Cells(R, AC)) + Val(Cells(R, AT))

			  If Cells(R, AC) = "" And Cells(R, AT) = "" Then Cells(R, AD) = ""

	    End If

    Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

الف شكر عباد بك

الله يبارك فيك

طيب لو تكرمت ما التغيير الذى اقوم به للتعامل مع المعادلة التالية

وهى تختلف عن المعادلة السابقة فى عدد الخانات التى سيتم جمعها حيث أنها 3 خانات وليس إثنتين

حيث يتم جمع خلايا الأعمدة رقم 56 و 57 و 58 فى العمود رقم 59

و الأعمدة رقم 81 و 82 و 83 فى العمود رقم 84


=IF(AND(BD11="غ";BE11="غ";BF11="غ");"غ";SUM(BD11:BF11))

والفكرة هى هى نفسها

غ + غ + غ = غ

أى أرقام + غ = مجموع الأرقام

أى أرقام فى ال3 خانات = مجموعهم

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

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

مشكورين جميعاً

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

العفو اخي يوسف

جرب هكذا 


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, "BD").End(xlUp).Row

For R = 11 To RR

   For TT = 1 To 12

	    AC = Choose(TT, 56, 81)

		 AT = Choose(TT, 57, 82)

		  AO = Choose(TT, 58, 83)

		   AD = Choose(TT, 59, 84)

			    If Cells(R, AC) = "غ" And Cells(R, AT) = "غ" And Cells(R, AO) = "غ" Then

				    Cells(R, AD) = "غ"

					 Else

				    Cells(R, AD) = Val(Cells(R, AC)) + Val(Cells(R, AT)) + Val(Cells(R, AO))

				    If Cells(R, AC) = "" And Cells(R, AT) = "" And Cells(R, AO) = "" _

				  Then Cells(R, AD) = ""

			    End If

	    Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

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

فى السطر السابع

إستخدمت السطر التالى طبقاً للكود الذى أرفقته سيادتكم سابقاً


RR = Cells(Rows.Count, 9).End(xlUp).Row
ولكن فى كودكم الآخر إستخدمتم هذا السطر 

RR = Cells(Rows.Count, "BD").End(xlUp).Row

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

الف شكر يا أخى الغالى

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

غيرت العمود المراد

اخذ اخر خليه بها بيانات منه

للدلاله على تنفيذ الكود حتى اخر خليه بها بيانات فقط

دون المرور على كافة الخلايا

طلبك الاخير بدء من عمود "BD"

والطلب السابق بدء من عمود 9 اللي هو "i"

ارجو ان تكون وصلت المعلومه

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

الف شكر على الشرح الوافى

وصلت الفكرة

وهنا أطمع فى إضافة طلب آخر

تحويل المعادلة التالية إلى كود


=IF(AND(L11="غ";W11="غ";AH11="غ";AT11="غ";BH11="غ";BU11="غ";CG11="غ";CR11="غ";CW11="غ");0;SUM(L11;W11;AH11;AT11;BH11;BU11;CG11;CR11;CW11))

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

كما يوجد إختلاف آخر فى النتيجة فتكرار الـ غ فى كل الخلايا المجموعة تكون نتيجته صفر أى غ + غ 9 مرات لا تعطى نتيجة غ مثلما سبق ولكن تعطى صفر بالحساب لأن هذا العمود سيتم إستخدام مخرجاته فى ترتيب الطالبات ولابد أن تكون به أرقام حتى لا يظهر إرور فى دالة الترتيب

بينما أن وجود غ فى بعض الخلايا ووجود أرقام فى خلايا أخرى يجعل النتيجة هى مجموع الأرقام عادى مثلما سبق

وهنا إسمحلى أن أطلب منك أن أضع الكود أولاً وتقوم سيادتكم بتصحيحه بعد ذلك لعلى أتعلم منكم يا استاذى الكريم

أمهلنى ربع ساعة لوضع الكود عزيزى الغالى

الف شكر

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر (معدل)

الأخ الغالى ابو نصار

تم عمل الكود التالى للجمع بدلاً من المعادلة فى المشاركة السابقة

على نفس منوال الكود الذى أرفقته سيادتكم من قبل

هل كتابته سليمة أم ترى يشوبها شئ من الناحية الفنية ؟؟


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

For TT = 1 To 12

	 D1 = Choose(TT, 12)

	 D2 = Choose(TT, 23)

	 D3 = Choose(TT, 34)

		 D4 = Choose(TT, 46)

		 D5 = Choose(TT, 60)

		 D6 = Choose(TT, 73)

		 D7 = Choose(TT, 85)

			 D8 = Choose(TT, 96)

			 D9 = Choose(TT, 101)

			 DA = Choose(TT, 105)

				 If Cells(R, D1) = "غ" And Cells(R, D2) = "غ" And Cells(R, D3) = "غ" _

				 And Cells(R, D4) = "غ" And Cells(R, D5) = "غ" And Cells(R, D6) = "غ" _

				 And Cells(R, D7) = "غ" And Cells(R, D8) = "غ" And Cells(R, D9) = "غ" Then

				 Cells(R, DA) = 0

		 Else

			 Cells(R, DA) = Val(Cells(R, D1)) + Val(Cells(R, D2)) + Val(Cells(R, D3)) + _

			 Val(Cells(R, D4)) + Val(Cells(R, D5)) + Val(Cells(R, D6)) + _

			 Val(Cells(R, D7)) + Val(Cells(R, D8)) + Val(Cells(R, D9))

				 If Cells(R, D1) = "" And Cells(R, D2) = "" And Cells(R, D3) = "" _

				 And Cells(R, D4) = "" And Cells(R, D5) = "" And Cells(R, D6) = "" _

				 And Cells(R, D7) = "" And Cells(R, D8) = "" And Cells(R, D9) = "" _

				 Then Cells(R, DA) = ""

			 End If

	 Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

سؤال آخر

هل ترى سيادتكم أنه من الأفضل أن يتم وضع الكود فى حدث الصفحة ؟؟

أم يتم ربطه بزر فى موديول وبالضغط على الزر يتم تحديث البيانات وجمعها ؟؟

حيث لا تزال الشاشة تومض بعض الشئ لكثرة الأكواد فى حدث نفس الصفحة

أم هل هناك حل آخر عن طريق دمج كل الأكواد فى كود واحد ؟؟

بمعنى آخر لو نريد وضع الأكواد الثلاثة السابقة مع كود رابع بنفس الفكرة جمع خلايا غير متجاورة فى نفس الصفحة هل يتم وضع هذه الأكواد كما هى تحت بعضها ؟؟

أم لابد من دمجها لتكون كود واحد

دمتم بخير

تم تعديل بواسطه يوسف عطا
رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر (معدل)

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

غ + غ = غ

غ + رقم = الرقم

رقم + رقم = مجموعهما

الكود هو كالتالى وهو يعمل بكفاءة


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

For TT = 1 To 32

	 AC = Choose(TT, 9, 14, 11, 20, 25, 22, 31, 36, 33, 49, 48, 45, 63, 62, 59, 70, 75, 72, 88, 87, 84, 95, 100, 109, 114, 111, 120, 125, 122)

		 AT = Choose(TT, 10, 15, 16, 21, 26, 27, 32, 37, 38, 50, 51, 52, 64, 65, 66, 71, 76, 77, 89, 90, 91, 97, 102, 110, 115, 116, 121, 126, 127)

		 AD = Choose(TT, 11, 16, 17, 22, 27, 28, 33, 38, 39, 51, 52, 53, 65, 66, 67, 72, 77, 78, 90, 91, 92, 98, 103, 111, 116, 117, 122, 127, 128)

			 If Cells(R, AC) = "غ" And Cells(R, AT) = "غ" Then

					 Cells(R, AD) = "غ"

						 Else

					 Cells(R, AD) = Val(Cells(R, AC)) + Val(Cells(R, AT))

						 If Cells(R, AC) = "" And Cells(R, AT) = "" Then Cells(R, AD) = ""

			 End If

	 Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub
المطلوب الأول أريد دمج الكود السابق مع الكود التالى 

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

   For TT = 1 To 12

	  D1 = Choose(TT, 12, 18)

	   D2 = Choose(TT, 23, 29)

	    D3 = Choose(TT, 34, 40)

		 D4 = Choose(TT, 46, 54)

		  D5 = Choose(TT, 60, 68)

		   D6 = Choose(TT, 73, 79)

		    D7 = Choose(TT, 85, 93)

			 D8 = Choose(TT, 96, 99)

			  D9 = Choose(TT, 101, 104)

			   DA = Choose(TT, 105, 107)

				    If Cells(R, D1) = "غ" And Cells(R, D2) = "غ" And Cells(R, D3) = "غ" _

				    And Cells(R, D4) = "غ" And Cells(R, D5) = "غ" And Cells(R, D6) = "غ" _

				    And Cells(R, D7) = "غ" And Cells(R, D8) = "غ" And Cells(R, D9) = "غ" Then

				    Cells(R, DA) = 0

		  Else

			  Cells(R, DA) = Val(Cells(R, D1)) + Val(Cells(R, D2)) + Val(Cells(R, D3)) + _

			  Val(Cells(R, D4)) + Val(Cells(R, D5)) + Val(Cells(R, D6)) + _

			  Val(Cells(R, D7)) + Val(Cells(R, D8)) + Val(Cells(R, D9))

				    If Cells(R, D1) = "" And Cells(R, D2) = "" And Cells(R, D3) = "" _

				    And Cells(R, D4) = "" And Cells(R, D5) = "" And Cells(R, D6) = "" _

				    And Cells(R, D7) = "" And Cells(R, D8) = "" And Cells(R, D9) = "" _

				    Then Cells(R, DA) = ""

			  End If

	   Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

توجد مجموعة أخرى من المعادلات سبق عرضهما فى المشاركات لجمع 3 خلايا فى المشاركة رقم 8 وكودها فى المشاركة 9 وبنفس الشروط السابقة بخصوص غ

ونريد أن نجعل الثلاث أكواد كود واحد

تم تعديل بواسطه يوسف عطا
رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

السلام عليكم

الاخ الفاضل يوسف

افضل ان يتم استدعاء الكود

عند دخول المصنف وعند الاغلاق

هكذا


'**********************

' حدث ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call D_AlS

End Sub

Private Sub Workbook_Open()

Call D_AlS

End Sub

'

'**********************

'==========================

' مودويل

Public Sub D_AlS()

On Error Resume Next

Dim RR&, R&

Dim RT&, RI&, A%, B%

Dim V_Ali As Variant

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

  For TT = 1 To 32

    AC = Choose(TT, 9, 14, 11, 20, 25, 22, 31, 36, 33, 49, 48, 45, 63, 62, 59, 70, 75, 72, 88, 87, 84, 95, 100, 109, 114, 111, 120, 125, 122)

	 AT = Choose(TT, 10, 15, 16, 21, 26, 27, 32, 37, 38, 50, 51, 52, 64, 65, 66, 71, 76, 77, 89, 90, 91, 97, 102, 110, 115, 116, 121, 126, 127)

	  AD = Choose(TT, 11, 16, 17, 22, 27, 28, 33, 38, 39, 51, 52, 53, 65, 66, 67, 72, 77, 78, 90, 91, 92, 98, 103, 111, 116, 117, 122, 127, 128)

	   If Cells(R, AC) = "غ" And Cells(R, AT) = "غ" Then

		 Cells(R, AD) = "غ"

	   Else

		 Cells(R, AD) = Val(Cells(R, AC)) + Val(Cells(R, AT))

	   If Cells(R, AC) = "" And Cells(R, AT) = "" Then Cells(R, AD) = ""

	   End If

   Next

Next

RT = Cells(Rows.Count, 1).End(xlUp).Row

V_Ali = Array(12, 18, 23, 29, 34, 40, 46, 54, 60, 68, 73, 79, 85, 93, 96, 99, 101, 104)

For RI = 11 To RT

   For TT = 1 To 18

	  D1 = Choose(TT, 12, 18, 23, 29, 34, 40, 46, 54, 60, 68, 73, 79, 85, 93, 96, 99, 101, 104)

	  A = V_Ali(0)

	  B = V_Ali(UBound(V_Ali))

	    DA = Choose(TT, 105, 107)

		  If Cells(RI, D1) = "غ" Then

			  Cells(RI, DA) = 0

		  Else

Cells(RI, DA) = WorksheetFunction.Sum(Range(Cells(RI, Val(A)), Cells(RI, Val(B))))

		  If Cells(RI, D1) = "" Then Cells(RI, DA) = ""

		  End If

	   Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

أخى الغالى عباد بك

بعد السلام عليكم

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

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

فجمعتها مع بعض التغيير فى المسميات ووضعتها فى موديول يتم إستدعائه بزر أضغط عليه فى شيت الدرجات

وهو الكود المرفق هنا

ولكن ظهرت حاجة غريبة أعتقد لأن الكود بعد أن غيرت فيه ينقصه سطر ما

حيث لا يقوم بعمليات الجمع العديدة به إلا بعد الضغط مرتين على الزر

يعنى أول ضغطة على الزر تنجز بعض العمليات فقط ثم اضغط مرة أخرى لإستكمال عمليات الجمع

أرجو تبيان الخطأ فيه مع تقديرى وإحترامى


Sub جمع_الكل()

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

For TT = 1 To 100

	 D1 = Choose(TT, 12, 18)

	 D2 = Choose(TT, 23, 29)

	 D3 = Choose(TT, 34, 40)

		 D4 = Choose(TT, 46, 54)

		 D5 = Choose(TT, 60, 68)

		 D6 = Choose(TT, 73, 79)

		 D7 = Choose(TT, 85, 93)

			 D8 = Choose(TT, 96, 99)

			 D9 = Choose(TT, 101, 104)

			 DA = Choose(TT, 105, 107)

				 If Cells(R, D1) = "غ" And Cells(R, D2) = "غ" And Cells(R, D3) = "غ" _

				 And Cells(R, D4) = "غ" And Cells(R, D5) = "غ" And Cells(R, D6) = "غ" _

				 And Cells(R, D7) = "غ" And Cells(R, D8) = "غ" And Cells(R, D9) = "غ" Then

				 Cells(R, DA) = 0

		 Else

			 Cells(R, DA) = Val(Cells(R, D1)) + Val(Cells(R, D2)) + Val(Cells(R, D3)) + _

			 Val(Cells(R, D4)) + Val(Cells(R, D5)) + Val(Cells(R, D6)) + _

			 Val(Cells(R, D7)) + Val(Cells(R, D8)) + Val(Cells(R, D9))

				 If Cells(R, D1) = "" And Cells(R, D2) = "" And Cells(R, D3) = "" _

				 And Cells(R, D4) = "" And Cells(R, D5) = "" And Cells(R, D6) = "" _

				 And Cells(R, D7) = "" And Cells(R, D8) = "" And Cells(R, D9) = "" _

				 Then Cells(R, DA) = ""

			 End If

	 E1 = Choose(TT, 42, 56, 81)

		 E2 = Choose(TT, 43, 57, 82)

		 E3 = Choose(TT, 44, 58, 83)

		 E4 = Choose(TT, 45, 59, 84)

			 If Cells(R, E1) = "غ" And Cells(R, E2) = "غ" And Cells(R, E3) = "غ" Then

					 Cells(R, E4) = "غ"

						 Else

					 Cells(R, E4) = Val(Cells(R, E1)) + Val(Cells(R, E2)) + Val(Cells(R, E3))

						 If Cells(R, E1) = "" And Cells(R, E2) = "" And Cells(R, E3) = "" Then Cells(R, E4) = ""

			 End If

	 A1 = Choose(TT, 9, 14, 11, 20, 25, 22, 31, 36, 33, 49, 48, 45, 63, 62, 59, 70, 75, 72, 88, 87, 84, 95, 100, 109, 114, 111, 120, 125, 122)

		 A2 = Choose(TT, 10, 15, 16, 21, 26, 27, 32, 37, 38, 50, 51, 52, 64, 65, 66, 71, 76, 77, 89, 90, 91, 97, 102, 110, 115, 116, 121, 126, 127)

		 A3 = Choose(TT, 11, 16, 17, 22, 27, 28, 33, 38, 39, 51, 52, 53, 65, 66, 67, 72, 77, 78, 90, 91, 92, 98, 103, 111, 116, 117, 122, 127, 128)

			 If Cells(R, A1) = "غ" And Cells(R, A2) = "غ" Then

					 Cells(R, A3) = "غ"

						 Else

					 Cells(R, A3) = Val(Cells(R, A2)) + Val(Cells(R, A1))

						 If Cells(R, A1) = "" And Cells(R, A2) = "" Then Cells(R, A3) = ""

			 End If

	 Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

الملف مرفق

جمع متنوع.rar

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

جرب هكذا فصلنا الحلقات


Sub جمع_الكل()

On Error Resume Next

Dim RR&, R&

With Application

.ScreenUpdating = False

.EnableEvents = False

RR = Cells(Rows.Count, 1).End(xlUp).Row

For R = 11 To RR

   For TT = 1 To 2

	  D1 = Choose(TT, 12, 18)

	   D2 = Choose(TT, 23, 29)

	    D3 = Choose(TT, 34, 40)

		 D4 = Choose(TT, 46, 54)

		  D5 = Choose(TT, 60, 68)

		   D6 = Choose(TT, 73, 79)

		    D7 = Choose(TT, 85, 93)

			 D8 = Choose(TT, 96, 99)

			  D9 = Choose(TT, 101, 104)

			   DA = Choose(TT, 105, 107)

				    If Cells(R, D1) = "غ" And Cells(R, D2) = "غ" And Cells(R, D3) = "غ" _

				    And Cells(R, D4) = "غ" And Cells(R, D5) = "غ" And Cells(R, D6) = "غ" _

				    And Cells(R, D7) = "غ" And Cells(R, D8) = "غ" And Cells(R, D9) = "غ" Then

				    Cells(R, DA) = 0

		  Else

			  Cells(R, DA) = Val(Cells(R, D1)) + Val(Cells(R, D2)) + Val(Cells(R, D3)) + _

			  Val(Cells(R, D4)) + Val(Cells(R, D5)) + Val(Cells(R, D6)) + _

			  Val(Cells(R, D7)) + Val(Cells(R, D8)) + Val(Cells(R, D9))

				    If Cells(R, D1) = "" And Cells(R, D2) = "" And Cells(R, D3) = "" _

				    And Cells(R, D4) = "" And Cells(R, D5) = "" And Cells(R, D6) = "" _

				    And Cells(R, D7) = "" And Cells(R, D8) = "" And Cells(R, D9) = "" _

				    Then Cells(R, DA) = ""

			 End If

   Next

Next

For Rt = 11 To RR

   For T1 = 1 To 3

	    E1 = Choose(T1, 42, 56, 81)

		 E2 = Choose(T1, 43, 57, 82)

		  E3 = Choose(T1, 44, 58, 83)

		   E4 = Choose(T1, 45, 59, 84)

			    If Cells(Rt, E1) = "غ" And Cells(Rt, E2) = "غ" And Cells(Rt, E3) = "غ" Then

					    Cells(Rt, E4) = "غ"

						  Else

					    Cells(Rt, E4) = Val(Cells(Rt, E1)) + Val(Cells(Rt, E2)) + Val(Cells(Rt, E3))

						  If Cells(Rt, E1) = "" And Cells(Rt, E2) = "" And Cells(Rt, E3) = "" Then Cells(Rt, E4) = ""

			    End If

  Next

Next

For Rt1 = 11 To RR

   For T2 = 1 To 29

	    A1 = Choose(T2, 9, 14, 11, 20, 25, 22, 31, 36, 33, 49, 48, 45, 63, 62, 59, 70, 75, 72, 88, 87, 84, 95, 100, 109, 114, 111, 120, 125, 122)

		 A2 = Choose(T2, 10, 15, 16, 21, 26, 27, 32, 37, 38, 50, 51, 52, 64, 65, 66, 71, 76, 77, 89, 90, 91, 97, 102, 110, 115, 116, 121, 126, 127)

		  A3 = Choose(T2, 11, 16, 17, 22, 27, 28, 33, 38, 39, 51, 52, 53, 65, 66, 67, 72, 77, 78, 90, 91, 92, 98, 103, 111, 116, 117, 122, 127, 128)

			    If Cells(Rt1, A1) = "غ" And Cells(Rt1, A2) = "غ" Then

					    Cells(Rt1, A3) = "غ"

						  Else

					    Cells(Rt1, A3) = Val(Cells(Rt1, A2)) + Val(Cells(Rt1, A1))

						  If Cells(Rt1, A1) = "" And Cells(Rt1, A2) = "" Then Cells(Rt1, A3) = ""

			    End If

    Next

Next

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

رابط هذا التعليق
شارك
يوسف عطا

يوسف عطا

قام بنشر
  • الكاتب
قام بنشر

للأسف يا عزيزى الغالى لا زال نفس الأمر يحدث

والغريب أن الحلقة الأولى فى الكود هى التى تتأخر ويتم تنفيذها فى الكبسة التانية للزر

بالطبع مش مشكلة يعنى ممكن من تعليمات الملف إن نعمل دبل كليك على الزر للجمع الكلى

لكن من باب العلم بالشئ وإكتشاف سبب المشكلة نأمل أن نتوصل لسبب هذا الأمر

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept