كود حساب عدد الخلايا التى بها دوائر حمراء

[عطية23]

السلام عليكم 

المطلوب هو كود لحساب عدد الخلايا التى عليها دوائر 

ولكم جزيل الشكر

عدد الخلايا التى حولها دائرة.xls

[ابراهيم الحداد]

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

استخدم الكود التالى

Sub Shap_Count()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.AutoShapeType = msoShapeOval Then
p = p + 1
End If
Next
MsgBox "عدد الدوائر فى الورقة هو : " & p & " دائرة"

End Sub

 

[عطية23]

استاذى العزيز

السلام عليكم

وجدت هذا الكود ولكن اطلب تعديل عليه

Function CountShapes(rngSearch As Range) As Integer
    Dim sh As Shape
   
    For Each sh In rngSearch.Parent.Shapes
        If Not Intersect(rngSearch, sh.TopLeftCell) Is Nothing Then
            CountShapes = CountShapes + 1
        End If
    Next sh
End Function

هو ان يكون مدى الكود صف مثلا يعد الدوائر منa2 : a9 يكتب العدد في الخلية a11

 وهكذا مع باقي الصفوف

[ابراهيم الحداد]

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

تم تعديل الكود بحيث تقوم انت اولا بتحديد النطاق المراد عد الدوائر فية

ثم الضغط على الزر المربوط به هذا الكود

فتظهر لك رسالة بعدد الدوائر فى هذا النطاق

Sub Shap_Count3()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If Not Intersect(Selection, sh.TopLeftCell) Is Nothing Then
p = p + 1
End If
Next
MsgBox "عدد الدوائر فى الورقة هو : " & p & " دائرة"
End Sub

 

[عطية23]

استاذنا الفاضل 

سلام الله عليكم

انا اسف ان اثقل عليكم 

لكن المطلوب ويمكن ان تحققه هو fucation count shapes

لانها معادلة توضع بجوار الدوائر وتكتب العدد لكل صف ولكن الكود اللي انا ارفقته لحضرتك يعمل على الاعمدة وليس الصفوف كما انه يعمل علة مدى صفيف وليس صف اتمنى ان اكون اوضحت المطلوب واسف على الازعاج والارهاق الذي اسببه لحضرتك

[أ / محمد صالح]

أقترح استخدام معادلة العد بنفس الشرط أو الشروط التي رسمت بها الدوائر

وليس عد الدوائر نفسها

بالتوفيق 

[عطية23]

استاذنا محمد صالح

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

[أ / محمد صالح]

18 ساعات مضت, عطية23 said:

لان الدوائر رسمت بشروط تختلف عن شروط العد

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

21 ساعات مضت, أ / محمد صالح said:

بنفس الشرط أو الشروط التي رسمت بها الدوائر

مثلا رسمت الدوائر على الخلايا التي مجموعها أقل من 50 من 100 نستعمل معادلة countif وإذا كان العد بأكثر من شرط نستعمل countifs

بالتوفيق

[عطية23]

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

الدوائر لم ترسم بشرط اكبر من ولا اضغر من لكنها رسمت بشرط العدد حيث ان الدوائر رسمت على حصص زائدة عن نصاب المعلم فالشرط كان عدد الحصص في نهاية او بداية الجدول مشكور على اهتمامك استاذنا الفاضل

وضع دوائر حمراء على الحصص.xls

[أ / محمد صالح]

بعد ملاحظة الكود الخاص بإضافة الدوائر

تبين أنها رسمت بشرط ألا تكون الخلية فارغة وأن يكون بها / وألا يزيد عددها عن الأرقام الموجودة في العمود v أو w

لذلك فعددها هو نفس الرقم الموجود في العمود v أو w

[عطية23]

استاذي الفاضل طلبى هو عد الدوائر في صف وليس كل الدوائر الموجودة في الجدول بل العد افقياً اي عدد الدوائر في النطاق مثلاً a5 :u5 وهكذا ولكم جزيل الشكر على الاهتمام

[حسونة حسين]

تفضل اخى الكريم عطيه

يتم العد في العامود z

وضع دوائر حمراء على الحصص ووضع عددها في العامود z.xls

[أ / محمد صالح]

في ١٠‏/١٢‏/٢٠٢١ at 21:22, عطية23 said:

استاذى العزيز

السلام عليكم

وجدت هذا الكود ولكن اطلب تعديل عليه

Function CountShapes(rngSearch As Range) As Integer
    Dim sh As Shape
   
    For Each sh In rngSearch.Parent.Shapes
        If Not Intersect(rngSearch, sh.TopLeftCell) Is Nothing Then
            CountShapes = CountShapes + 1
        End If
    Next sh
End Function

هو ان يكون مدى الكود صف مثلا يعد الدوائر منa2 : a9 يكتب العدد في الخلية a11

 وهكذا مع باقي الصفوف

بعد مراجعة الموضوع من أوله تبين أن هذه الدالة تفي بالغرض سواء في الأعمدة أو الصفوف 

لأن المستخدم يقدم لها نطاقا يمكن أن يكون صفا أو عمودا أو أكثر

مثال لاستخدامها لجمع الأعمدة نكتب في الخلية i15 

=CountShapes(I4:I14)

مثال لاستخدامها لجمع الصفوف نكتب في الخلية v5 

=CountShapes(A5:U5)

بالتوفيق 

[عطية23]

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

الاستاذ حسونة بوركت وجزاك الله خيراً هذا هو المطلوب تماماً بارك الله فيك وزادك علماً ومليون شكر

الاستاذ محمد صالح والاستاذ ابراهيم الحداد مليون شكر على اهتمامكم وتعاونكم جزاكم الله الخير والثواب

[حسونة حسين]

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

وجزاكم مثله اخى عطيه

والحمد لله الذي بنعمته تتم الصالحات