كيفية حساب عدد الأيام المتصلة

[أم عبد الله]

السلام عليكم ورحمة الله وبركاته كل عام وأنتم بخير بمناسبة شهر رمضان الكريم أرجو من خبراء الأكسيل بالمنتدى مساعدتي في كيفية حساب عدد الأيام المتصلة ومرفق الملف وجزاكم الله خيراً

[أم عبد الله]

الأخوة الأعزاء خبراء الاكسيل أرجو الرد على طلبي وهل يمكن عمل هذه الدالة أم لا أرجو إفادتي ولكم جزيل الشكر

[أم عبد الله]

السلام عليكم ورحمة الله وبركاته أستاذنا الفاضل عملاق الأكسيل أرجو مساعدتي في هذا الملف مرفق الملف

[konafa4000]

اين المرفق

[أم عبد الله]

أخي العزيز konaffa4000المرفق في المشاركة الأولى باسم كيفية حساب الأيام المتصلة لأن الموقع حالياً مغلق أرجو الرد للأهمية ولكم جزيل الشكر

تم تعديل أغسطس 28, 2010 بواسطه fzsss

[طارق محمود]

السلام عليكم

أختنا الفاضلة

أرجو أن يكون المرفق هو ماتريدين

A1_TAREQ.rar

[هشام شلبى]

السلام عليكم

===========

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

والشكر موصول لكل المشاركين وكل عام وانتم بخير

لمزيد من الافادة

الاخ صاحب المشاركة ستضع هذه الصيغة فى AX4

=LOOKUP(MAX(FREQUENCY(IF($D4:$AU4="غ";COLUMN($D4:$AU4));IF($D4:$AU4<>"غ";COLUMN($D4:$AU4))));{0,4,8,12,15};{"";"ن 1";"ن 2";"ن3";"مفصول"})

وبعد وضعها اضغط Ctrl+Shift+Enter

ان شاء الله هو ما تريد

شاهد المرفق

اعتذارات طلبة hh.rar

[أم عبد الله]

السلام عليكم

===========

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

والشكر موصول لكل المشاركين وكل عام وانتم بخير

لمزيد من الافادة

الاخ صاحب المشاركة ستضع هذه الصيغة فى AX4

=LOOKUP(MAX(FREQUENCY(IF($D4:$AU4="غ";COLUMN($D4:$AU4));IF($D4:$AU4<>"غ";COLUMN($D4:$AU4))));{0,4,8,12,15};{"";"ن 1";"ن 2";"ن3";"مفصول"})

وبعد وضعها اضغط Ctrl+Shift+Enter

ان شاء الله هو ما تريد

شاهد المرفق

[أم عبد الله]

الأخوة الأعزاء أنا عاجزة عن الشكر وجزاكم الله الجنة وغفر لنا ولكم وأمة سيدنا محمد أحياءً وأمواتاً وجعله الله في ميزان حسناتكم ولكن أخي العزيز المهندس طارق أرجو شرح دالةabsent لأنني لم أفهمها ولكم جزيل الشكر

تم تعديل سبتمبر 3, 2010 بواسطه fzsss

[طارق محمود]

الأخوة الأعزاء أنا عاجزة عن الشكر وجزاكم الله الجنة وغفر لنا ولكم وأمة سيدنا محمد أحياءً وأمواتاً وجعله الله في ميزان حسناتكم ولكن أخي العزيز المهندس طارق أرجو شرح دالةabsent لأنني لم أفهمها ولكم جزيل الشكر

السلام عليكم

أختي الفاضلة

هذه الدالة غير موجودة أصلا بالإكسل

لقد تم تصنيعها (إن جاز القول) خصيصا لتناسب طلبك

إن فتحتي محرر الفيجوال بيزيك ستجدين الماكرو الخاص بها

كالتالي

Function absent(x As Range) As Double


a = [a2].Value

absent = 0

For Each cl In x


 If cl.Value = a Then

 	i = 1

 	For k = 1 To 40

 	If cl.Offset(0, k).Value = a Then

 	i = i + 1

 	Else

 	If cl.Offset(0, k).Interior.ColorIndex <> xlNone Then

 	GoTo 100

 	Else: GoTo 200

 	End If

 	End If

100 	Next k

200 	If absent < i Then absent = i: cl.Offset(0, k).Interior.ColorIndex = 4: i = 0

	Else

	End If


Next


End Function

[أم عبد الله]

أخي العزيز المهندس / طارق أنا عاجزة عن الشكر لسرعة الرد والمساعدة الكبيرة التي تقدمها لأعضاء المنتدى وبالنسبة للدالة فهى ممتازة وفعلاً غير موجودة بالاكسيل وهذا يدل على علمك الكبير الله لا يحرمنا منه وجعله الله في ميزان حسناتك وعندما فتحت محرر الفيجوال وجدتها ولكن عندما أضفت بعض الصفوف والأعمدة فكانت الصيغة بها خطأ وحاولت تعديل في الدالة من محرر الفيجوال فلن أستطيع فأرجو من حضرتك تعديل الصيغة في الملف المرفق وشرحها للإفادة من علم حضرتك ولك جزيل الشكر.

تم تعديل سبتمبر 4, 2010 بواسطه fzsss

[طارق محمود]

السلام عليكم

أختنا الفاضلة

لديك عدة نقاط تحتاج تضبيط

أولا : حيث أن الدالة غير موجودة أصلا بالإكسل كما سبق واتفقنا، فلابد إذن من نقلها للملف الجديد

والنقل عن طريق محرر الفيجوال بيزيك أو نقل الملف المرفق بما فيه من ماكرو أو دالة

ثانيا: لكي ترصد الدالة جميع أحوال الطالب فيجب أن تكون الدالة من أول يوم أي كالتالي

=absent(D8:IK8)

وليست

 =absent(ID8:IK8)

ثالثا: بعد تعديل طفيف ، أصبحت الدالة كالتالي إذا لاحظتي أول سطر بعد التعريف هو: a = [a2].Value نضع قيمة الخلية A2 في المتغير a وهذا الأمر لأن لدي بالجهاز مشكلة في التعرف علي أشكال الحروف العربية فوضعت في الملف السابق حرف غ في الخلية A2 لكي يقرأ منها الكود حرف غ ليستخدمه في المقارنة بعد ذلك لذلك لابد من وضع هذا الحرف غ في الخلية A2 ولو نغير لون الفونط مثلا للأبيض كما في الملف السابق الكود بعد التعديل

Function absent(x As Range) As Double


a = [a2].Value

absent = 0

For Each cl In x


 If cl.Value = a Then

        i = 1

        For k = 1 To 40

            If cl.Offset(0, k).Value = a Then

                i = i + 1

            Else

                If cl.Offset(0, k).Interior.ColorIndex <> xlNone Then

                      GoTo 100

                Else: GoTo 200

                End If

            End If

100     Next k

200     If absent < i Then absent = i: i = 0

        End If


Next


End Function

تفضلي المرفق بعد التعديلات السابقة

A1_Tareq2.rar

[أم عبد الله]

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

الأخ العزيز المهندس / طارق أنا عاجزة عن الشكر وجعلك هذا العلم في ميزان حسناتك وجزاك الله الفردوس الأعلى من الجنة.

تم تعديل سبتمبر 5, 2010 بواسطه fzsss