سيد الأكـرت قام بنشر الخميس at 23:11 مشاركة قام بنشر الخميس at 23:11 اساتذتنا الكرام الملف ارجو المساعدة في الملف المرفق وفيه كود لوضع دوائر حمراء على الحصص الزائدة المطلوب تعديل الكود ليتجاهل الخلايا الفارغة ثم جمع الخلايا المحاطة بدوائر حمراء كل يوم ووضعها في الجدول الثاني مع مراعاة إذا كان اليوم غ أو أجازة تكتب مكان العدد ويتم حساب الاجمالي بشكل صحيح وجزاكم الله خيرا الاجر.xls رابط هذا التعليق شارك More sharing options...
سيد الأكـرت قام بنشر منذ 4 ساعات الكاتب مشاركة قام بنشر منذ 4 ساعات هل ممكن كود لاستدعاء حصص المعلم من جدول البيانات حسب تسلسله رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر منذ 4 ساعات أفضل إجابة مشاركة قام بنشر منذ 4 ساعات في 27/9/2024 at 00:11, سيد الأكـرت said: المطلوب تعديل الكود ليتجاهل الخلايا الفارغة جرب هدا Sub Draw_Circles() Const nMax As Integer = 38 Dim mx, v As Shape, x As Integer, r As Long, c As Long, cnt As Long Call Remove_Circles x = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 mx = Range("s10").Value If mx = 0 Or Not IsNumeric(mx) Then MsgBox "Enter Valid Number In Cell s10", vbExclamation: GoTo Skipper For c = 8 To 2 Step -1 For r = 9 To 13 Step 1 With Cells(r, c) If .Value > 0 Then cnt = cnt + 1 Set v = .Parent.Shapes.AddShape(msoShapeOval, .Left + 2, .Top + 2, .Width - 4, .Height - 4) v.Fill.Visible = msoFalse v.Line.ForeColor.SchemeColor = 10 v.Line.Weight = 2 If cnt = mx Then Exit For End If End With Next r If cnt = mx Then Exit For Next c cnt = 0 Skipper: ActiveWindow.Zoom = x Application.ScreenUpdating = True MsgBox "مبروك...", 64 End Sub 2 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر منذ 1 ساعه مشاركة قام بنشر منذ 1 ساعه 2 ساعات مضت, سيد الأكـرت said: هل ممكن كود لاستدعاء حصص المعلم من جدول البيانات حسب تسلسله ادا كنت قد فهمت طلبك بشكل صحيح ربما هدا سيوفي بالغرض سيتم تنفيد الكود عند التغيير في خلية التسلسل (K1) ورقة الأساسي Sub Test() Dim dest As Worksheet, WS As Worksheet Dim linge As String, arr As Variant Dim i As Long, LastRow As Long, OnRng As Range Dim Irow As Long, j As Long, Cnt As Long Dim dataArr As Variant Set WS = Sheets("البيانات") Set dest = Sheets("الأساسي") linge = dest.[K1].Value If linge = "" Then MsgBox "الرجاء إدخال تسلسل المعلم", vbExclamation: Exit Sub LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row Set OnRng = WS.Range("A3:A" & LastRow).Find(What:=linge, LookIn:=xlValues, LookAt:=xlWhole) If Not OnRng Is Nothing Then arr = Array("الأحد", "الاثنين", "الثلاثاء", "الأربعاء", "الخميس") Irow = 9 ' <<===== ' تحديد الصف الأول للصق البيانات Cnt = 6 ' <<===== ' ( F عمود) بداية من يوم الأحـــــــــــــد Application.ScreenUpdating = False ' تكرار لكل يوم (من الأحد إلى الخميس) ReDim dataArr(0 To UBound(arr), 0 To 7) ' تخزين 5 أيام و8 أعمدة لكل يوم For j = 0 To UBound(arr) For i = 0 To 7 dataArr(j, i) = WS.Cells(OnRng.Row, Cnt + i).Value Next i Cnt = Cnt + 8 Next j For j = 0 To UBound(arr) For i = 0 To 7 dest.Cells(Irow, i + 2).Value = dataArr(j, i) If IsDate(dest.Cells(Irow, i + 2).Value) Then dest.Cells(Irow, i + 2).NumberFormat = "m/d" ''<===== ' قم بتعديل تنسيق التاريخ بما يناسبك End If Next i Irow = Irow + 1 Next j ' جلب المعلومات الإضافية dest.[C5].Value = WS.Cells(OnRng.Row, 2).Value ' اسم المعلم dest.[K5].Value = WS.Cells(OnRng.Row, 3).Value ' المادة dest.[P5].Value = WS.Cells(OnRng.Row, 4).Value ' الوظيفة dest.[S9].Value = WS.Cells(OnRng.Row, 5).Value ' النصاب ' إجراء الحسابات dest.[S8].Value = Application.WorksheetFunction.CountA(dest.Range("B9:I13")) dest.[S10].Value = dest.[S8].Value - dest.[S9].Value ' إظافة الدوائر بعد تنفيد الكود ' Call Draw_Circles Else MsgBox "لم يتم العثور على تسلسل المعلم" & linge, vbExclamation End If Application.ScreenUpdating = True End Sub في 27/9/2024 at 00:11, سيد الأكـرت said: جمع الخلايا المحاطة بدوائر حمراء كل يوم ووضعها في الجدول الثاني مع مراعاة إذا كان اليوم غ أو أجازة تكتب مكان العدد ويتم حساب الاجمالي بشكل صحيح صراحة لم أستوعب الفكرة حاول تزويدنا بعينة للنتائج المتوقعة بعد تجربة الاكواد السابقة الاجر V1.xls 1 رابط هذا التعليق شارك More sharing options...
سيد الأكـرت قام بنشر منذ 56 دقائق الكاتب مشاركة قام بنشر منذ 56 دقائق (معدل) الله ينور على حضرتك يا باشمهندس محمد هشام تسلم ايديك الكودين ممتازين واوفوا بالغرض وزيادة ربنا يبارك في حضرتك ولو تكمل جميلك ويبقى فيه كود لعد الخلايا المحاطة بدائرة اكون شاكرا لحضرتك وفهم حضرتك للمطلوب صحيح عند تغيير الخلية k1 يتم استدعاء بيانات وجدول المدرس وقد تم بشكل صحيح لأنى قد قمت باستدعاءها بدالة vlookup لكن عند وجود خلية فارغة من الحصص الدالة تضع 0 وهنا كان الكود القديم يحيطها بدائرة لأنها ليست فارغة من وجهة نظره أما كود حضرتك ممتاز فهو يتجاهل الخلايا الفارغة وكود الاستدعاء منع وجود 0 مكان الخلية الفارغة جزاك الله خيرا واتمنى تحقيق الجزء الاخير ليكتمل الملف والمقصود به اذا كان يوجد يوم الاحد 3 حصص محاطة بدائرة حمراء يتم تسجيلها في الجدول الاسفل امام كل يوم الأحد 3 حصص ولو اليوم مفهش يكتب 0 ونستطيع بهذا حساب عدد الحصص الزائدى اسبوعيا عن طريق جمعها وإذا كان اليوم المدرس غائب ممكن ان نكتبها يدويا غ او اجازة ولو امكن معادلة الجمع تكون بتجمع الارقام لان وجود نص زي غ او اجازة هبخلي معادلة sum تعطى خطأ اتمنى ان اكون اوضحت المطلوب تم تعديل منذ 41 دقائق بواسطه سيد الأكـرت رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان