اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

الرجاء المساعدة فى تحويل المعادلة الآتية المتكررة فى العمود 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