يوسف عطا قام بنشر سبتمبر 19, 2012 مشاركة قام بنشر سبتمبر 19, 2012 الرجاء المساعدة فى تحويل المعادلة الآتية المتكررة فى العمود 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 تحويل معادلة إلى كود رابط هذا التعليق شارك More sharing options...
ghobashi قام بنشر سبتمبر 19, 2012 مشاركة قام بنشر سبتمبر 19, 2012 والله انا لما بحتاج اكرر معادلة بستعمل دالة concatenate وبفرغ المعادلة فى اكثر من خلية واسريل الارقام وبعدها اعملها كوبى بيست ,,,هيا طريقة متعبه بس هيا الا اقدر عليها رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر سبتمبر 19, 2012 مشاركة قام بنشر سبتمبر 19, 2012 جرب هذا الكود 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 رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 الله ينور عليك يا ابو حنين فعلاً كدة الكود قام بما تقوم به المعادلة فى 2000 صف ولكن عندى إستفسارين 1. الملف يتم تحديثه كل جزء من ثانية أثناء الكتابة فتظل علامة التحديث أو التحميل الخاصة بالإيكسيل موجودة دائماً وكذلك تتأخر عملية إدخال الدرجات كيف أتغلب على هذه النقطة 2. هل لتكرار نفس الكود فى أعمدة أخرى أقوم بكتابة كود جديد مع تغيير أرقام الأعمدة ؟؟ أم تغيير المتغير s ؟ أم تغيير كلاهما ؟؟ أم إضافة أرقام الأعمدة الأخرى فى نفس الكود ؟؟؟ حيث حاولت ولم أفلح علماً بأنى أريد تطبيق نفس الكود على الأعمدة رقم 11 و 16 و 22 و 27 و 33 و 38 و 72 و 77 و 111 و 116 و 122 و 127 ليجمع كل عمودان قبلهما أو يتعامل مع حرف غ كما طبقنا سلفاً غ + غ = غ غ + رقم = الرقم رقم + غ = الرقم رقم + رقم = مجموعهما رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 (معدل) بعد جهد جهيد توصلت لطريقة الدمج ليكون الكود مفعلاً فى عدة أعمدة كما يلى أرجو أن يكون صحيحاً من الناحية الفنية ولكن مشكلة تحديث الصفحة بستمرار لا زالت تحتاج حل لأن كل كليك أو إنتقال لخلية تجعل علامة تحديث الصفحة تومض آلاف المرات فأضطر للإنتظار أكثر من دقيقة حتى أتمكن من وضع رقم آخر فى خلية أخرى أرجو المساعدة فى حل المشكلة المذكورة الكود كما استخدمه كالتالى علماً بأنه سيتم تمديده ليتفعل على أعمدة أخرى وقد غيرت فى إسم المتغير 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 تم تعديل سبتمبر 20, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 هل لو غيرنا فى الكود الأصلى كما يلى نحصل على نفس النتيجة أم يصبح الكود خطأ من الناحية الفنية ؟؟ 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 رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر سبتمبر 20, 2012 مشاركة قام بنشر سبتمبر 20, 2012 السلام عليكم تفضل الكود في حدث الصفحه 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 رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 الف شكر عباد بك الله يبارك فيك طيب لو تكرمت ما التغيير الذى اقوم به للتعامل مع المعادلة التالية وهى تختلف عن المعادلة السابقة فى عدد الخانات التى سيتم جمعها حيث أنها 3 خانات وليس إثنتين حيث يتم جمع خلايا الأعمدة رقم 56 و 57 و 58 فى العمود رقم 59 و الأعمدة رقم 81 و 82 و 83 فى العمود رقم 84 =IF(AND(BD11="غ";BE11="غ";BF11="غ");"غ";SUM(BD11:BF11)) والفكرة هى هى نفسها غ + غ + غ = غ أى أرقام + غ = مجموع الأرقام أى أرقام فى ال3 خانات = مجموعهم جارى محاولة التطبيق بكود مشابه على نفس المنوال وسوف أعرضه هنا وأنتظر تصحيحه من سيادتكم لو كان به خطأ مشكورين جميعاً رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر سبتمبر 20, 2012 مشاركة قام بنشر سبتمبر 20, 2012 العفو اخي يوسف جرب هكذا 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 رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 بالفعل أستاذى عباد هذا ما قمت به عند التعديل مع فارق واحد فقط فى السطر السابع إستخدمت السطر التالى طبقاً للكود الذى أرفقته سيادتكم سابقاً RR = Cells(Rows.Count, 9).End(xlUp).Row ولكن فى كودكم الآخر إستخدمتم هذا السطر RR = Cells(Rows.Count, "BD").End(xlUp).Row فهل أطمع أن تخبرنى بالفرق بين السطرين ولماذا إستخدمت حضرتك السطر الأول فى الكود الأول والسطر الثانى فى الكود الثانى ؟؟ الف شكر يا أخى الغالى رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر سبتمبر 20, 2012 مشاركة قام بنشر سبتمبر 20, 2012 غيرت العمود المراد اخذ اخر خليه بها بيانات منه للدلاله على تنفيذ الكود حتى اخر خليه بها بيانات فقط دون المرور على كافة الخلايا طلبك الاخير بدء من عمود "BD" والطلب السابق بدء من عمود 9 اللي هو "i" ارجو ان تكون وصلت المعلومه رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 الف شكر على الشرح الوافى وصلت الفكرة وهنا أطمع فى إضافة طلب آخر تحويل المعادلة التالية إلى كود =IF(AND(L11="غ";W11="غ";AH11="غ";AT11="غ";BH11="غ";BU11="غ";CG11="غ";CR11="غ";CW11="غ");0;SUM(L11;W11;AH11;AT11;BH11;BU11;CG11;CR11;CW11)) والإختلاف هنا أن الخلايا التى سنتعامل معها ليست متجاورة مثلما كانت المعادلتان السابقتان كما يوجد إختلاف آخر فى النتيجة فتكرار الـ غ فى كل الخلايا المجموعة تكون نتيجته صفر أى غ + غ 9 مرات لا تعطى نتيجة غ مثلما سبق ولكن تعطى صفر بالحساب لأن هذا العمود سيتم إستخدام مخرجاته فى ترتيب الطالبات ولابد أن تكون به أرقام حتى لا يظهر إرور فى دالة الترتيب بينما أن وجود غ فى بعض الخلايا ووجود أرقام فى خلايا أخرى يجعل النتيجة هى مجموع الأرقام عادى مثلما سبق وهنا إسمحلى أن أطلب منك أن أضع الكود أولاً وتقوم سيادتكم بتصحيحه بعد ذلك لعلى أتعلم منكم يا استاذى الكريم أمهلنى ربع ساعة لوضع الكود عزيزى الغالى الف شكر رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 20, 2012 الكاتب مشاركة قام بنشر سبتمبر 20, 2012 (معدل) الأخ الغالى ابو نصار تم عمل الكود التالى للجمع بدلاً من المعادلة فى المشاركة السابقة على نفس منوال الكود الذى أرفقته سيادتكم من قبل هل كتابته سليمة أم ترى يشوبها شئ من الناحية الفنية ؟؟ 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 سؤال آخر هل ترى سيادتكم أنه من الأفضل أن يتم وضع الكود فى حدث الصفحة ؟؟ أم يتم ربطه بزر فى موديول وبالضغط على الزر يتم تحديث البيانات وجمعها ؟؟ حيث لا تزال الشاشة تومض بعض الشئ لكثرة الأكواد فى حدث نفس الصفحة أم هل هناك حل آخر عن طريق دمج كل الأكواد فى كود واحد ؟؟ بمعنى آخر لو نريد وضع الأكواد الثلاثة السابقة مع كود رابع بنفس الفكرة جمع خلايا غير متجاورة فى نفس الصفحة هل يتم وضع هذه الأكواد كما هى تحت بعضها ؟؟ أم لابد من دمجها لتكون كود واحد دمتم بخير تم تعديل سبتمبر 21, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 21, 2012 الكاتب مشاركة قام بنشر سبتمبر 21, 2012 (معدل) تم تجميع المعادلات المتشابهة فى كود واحد لجمع خليتين فى خلية ثالثة سواء كانت الخلايا متجاورة أو غير متجاورة مع إعتبار أن غ + غ = غ غ + رقم = الرقم رقم + رقم = مجموعهما الكود هو كالتالى وهو يعمل بكفاءة 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 وبنفس الشروط السابقة بخصوص غ ونريد أن نجعل الثلاث أكواد كود واحد تم تعديل سبتمبر 21, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر سبتمبر 21, 2012 مشاركة قام بنشر سبتمبر 21, 2012 السلام عليكم الاخ الفاضل يوسف افضل ان يتم استدعاء الكود عند دخول المصنف وعند الاغلاق هكذا '********************** ' حدث 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 رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 22, 2012 الكاتب مشاركة قام بنشر سبتمبر 22, 2012 أخى الغالى عباد بك بعد السلام عليكم الكود السابق الذى أرفقته حضرتك بصراحة تهت فيه وماعرفتش أمشى مع خطواته فعملت على الأكواد التى سبق أن أرفقتها سيادتكم من قبل فجمعتها مع بعض التغيير فى المسميات ووضعتها فى موديول يتم إستدعائه بزر أضغط عليه فى شيت الدرجات وهو الكود المرفق هنا ولكن ظهرت حاجة غريبة أعتقد لأن الكود بعد أن غيرت فيه ينقصه سطر ما حيث لا يقوم بعمليات الجمع العديدة به إلا بعد الضغط مرتين على الزر يعنى أول ضغطة على الزر تنجز بعض العمليات فقط ثم اضغط مرة أخرى لإستكمال عمليات الجمع أرجو تبيان الخطأ فيه مع تقديرى وإحترامى 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 رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر سبتمبر 22, 2012 مشاركة قام بنشر سبتمبر 22, 2012 جرب هكذا فصلنا الحلقات 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 رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر سبتمبر 22, 2012 الكاتب مشاركة قام بنشر سبتمبر 22, 2012 للأسف يا عزيزى الغالى لا زال نفس الأمر يحدث والغريب أن الحلقة الأولى فى الكود هى التى تتأخر ويتم تنفيذها فى الكبسة التانية للزر بالطبع مش مشكلة يعنى ممكن من تعليمات الملف إن نعمل دبل كليك على الزر للجمع الكلى لكن من باب العلم بالشئ وإكتشاف سبب المشكلة نأمل أن نتوصل لسبب هذا الأمر رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان