طارق محمود

السلام عليكم مجال بالإنجليزية Range والمقصود به مجموعة من الخلايا وقد يكون خلية واحدة فقط كما هو الحال في المثال السابق ولتسمية المدي أو النطاق أو الـ Range يوجد طريقتين (1) أن تقف علي ذلك المدي (تظلله لو أكثر من خلية) ثم تذهب لأقصي اليسار العلوي حيث يوجد عنوان الخلية النشطة وتعيد تسميته (2) حي أنك تستخدم 2007 فمن قائمة Formulas ، مجموعة Defined Names ، ثم Define Name لو في المثال السابق سميت الخلية B3 مثلا بالإسم A وكان هذا الإسم أو هذه الخلية تحتوي علي قيمة ولتكن dddd فإن الصيغة = A&5 ستعطي dddd5 ولن تعطي خطأ أنظر المرفق Name_Range.rar

السلام عليكم أخي الحبيب لامشاكل ولابد من توسيع الصدر قليلا فأخونا Kemas من الأحباب المجتهدين وله جهد واضح وكبير أنا شخصيا قد يأتيني من المنتدي أكثر من عشر رسائل في يوم واحد ولضيق الوقت ألغيها بدون قرائتها أحيانا إلتمس لأخيك ألف عذر سأغلق الموضوع وإن ظهر لك أي إستفسار إرسل عالإميل أو إفتح موضوع جديد ، كما تحب وكل عام وأنتم جميعا بخير

الرمز & يشبه علامة الجمع للأرقم ولكنه خاص بالحروف أو أشكال الأارقام ولايلغي العمليات الحسابية مثلا = "A"&"B" AB = "A"&5 A5 لكن = A&5 #NAME? أعطي خطأ لأن A ليست بين علامتي إقتباس فتعامل معها علي أنها متغير له قيمة ولكني لم أسمي مجالا بهذا الإسم ولم أعطي له قيمة وأيضا حسابيا = "A"&5/2 A2.5 تحياتي

السلام عليكم أخي الحبيب/ د.خالد أرجو أن تعذرني لتأخري بالرد عليك هذا هو كود دالة المجموع لوزن 69 أوأقل Function rnk69(bst, w As Range) As Variant Dim ss(99), tot(99), tot_mx(99), Asbaqya(99), qur3a(99), Asbaqya_cof(99), z(99) As Variant, st, fn As Range Set fn = [a1000].End(xlUp) Set st = fn.End(xlUp) play_N = WorksheetFunction.CountA(Range(st, fn)) For p = 1 To play_N For i = 1 To 3 tot(i) = Cells(st.Row, bst.Column).Offset(p - 1, i - 4) If WorksheetFunction.IsNumber(tot(i)) Then tot(i + 3) = tot(i) + (3 - i) * 0.1 Else tot(i + 3) = 0 End If If tot_mx(p) < tot(i + 3) Then tot_mx(p) = tot(i + 3) 'Asbaqya If tot(i) > "X" Then tot(i + 6) = Right(tot(i), Len(tot(i)) - 1) Else: tot(i + 6) = 0 End If If Asbaqya(p) < tot(i + 6) Then Asbaqya(p) = tot(i + 6) Next i mx_qur3a = WorksheetFunction.Max(Range("A:A")) qur3a(p) = (mx_qur3a - Cells(st.Row + p - 1, 1).Value) / mx_qur3a / 100 If mx_Asbaqya < Asbaqya(p) Then mx_Asbaqya = Asbaqya(p) Next p 'calculate each z(p) For p = 1 To play_N wp = Cells(st.Row - 1 + p, w.Column).Value If mx_Asbaqya = tot_mx(p) Then Asbaqya_cof(p) = -tot_mx(p) / 4 / wp Else: Asbaqya_cof(p) = 0 End If z(p) = (tot_mx(p) + (tot_mx(p) / wp)) + 0.00009 + Asbaqya_cof(p) + qur3a(p) Next p 'calculate Rank of bst s = bst.Row - st.Row + 1 If z(s) < 1 Then tot_rnk = "X": Exit Function If w <= 69 Then rnk = 1 Else rnk = 0: GoTo 111 ' assume For p = 1 To play_N wp = Cells(st.Row - 1 + p, w.Column).Value If wp > 69 Then GoTo 100 If z(p) > z(s) Then rnk = rnk + 1 100 Next p 111 rnk69 = rnk End Function ومثله مع تعديل طفبف كود دالة المجموع لوزن 77 أواأكثر تفضل المرفق وبه لمسات طفيفة للإخراج فقط sphinx11.rar

السلام عليكم أخي العزيز مرحب بك بين إخوانك رجاء مراجعة الروابط التالية http://www.officena.net/ib/index.php?showtopic=29748&st=0&p=148274&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry148274 أو http://www.officena.net/ib/index.php?showtopic=32704&st=0&p=168449&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry168449 أو http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156862&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156862 أو http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156669&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156669 وستجد فيها إن شاء الله ماتريد وأكثر

السلام عليكم أخي الكريم تفضل المرفق وبه الشرح في الأول تكون خلايا الإدخال التي منها ستتكون المعادلة ثم بالتنسيق الشرطي تربط إظهارها مع أي خلية تريدها تفضل المرفق تصميم2.rar

السلام عليكم بفرض ان الملف Sal موجود في المجلد SS داخل المجلدFolder1 علي الدرايف D وباقي الملفات موجودة كل منها في مجلد R00i داخل المجلدFolder1 أيضا علي الدرايف D حيث 00i هو رقم التقرير في نفس الوقت فقط إستبدل السطر a = "Report" & Format(i, "00#") & ".xls" بالسطر a = "D:\Folder1\SS\R" & Format(i, "00#") & "\Report" & Format(i, "00#") & ".xls"

السلام عليكم أخي العزيز / Kemas معذرة لطول وقت الموضوع مع أن هذا يرجع لعدة عوامل منها أن الأخ السائل (sphinx) لم يكن يعلم جيدا مايمكن عمله بالإكسل أنه أيضا كانت له طلبات متغيرة وغير بعضها وعلي فترات متقطعة لم يتدخل أحد غيري تقريبا للمساعدة في الموضوع في فترات غيابي عنه كلما فكرت في إغلاق الموضوع ومراسلة السائل فقط ، أجد دائما أعضاء أو زوار يتصفحون الموضوع فأجد نفسي لاأريد أن احرم من يبحث عن العلم عموما الموضوع كاد أن ينتهي وكل عام وأنتم بخير

السلام عليكم أخي العزيز/ د.خالد أولا أعذرني لتأخري بالرد عليك ثانيا من عيوب هذه الدالة أنها تحتاج إلي مايشبه الإنعاش Refresh مثل الجداول المحورية ولكنها سليمة وتعمل جيدا فقط كل ماعليك ان تنعشها وذلك بالوقوف في الخلايا التي بها الدالة من Q4 إلي Q16 وتضغط F2 ثم إنتر لكل خلية منها وستجد انها تعمل بكفاءة

السلام عليكم أخي الكريم من حظك أنني عملت موضوع مماثل لصديق منذ وقت قريب عدلت الكود كالتالي كود واحد فقط موجود في الملف Sal.xls كل ماعليك هو فقط أن تنسخ الكود إلي ملفك أو تنسخ الملف المرفق كله وتضعه مكان ملفك القديم (في نفس المجلد الذي به باقي الملفات) ثم إفتحه وإضغط الزر الأصفر لتشغيل الماكرو سيسألك عن عدد التقارير ثم سيبدأ فتحها واحدا واحدا يأخذ البيانات منه وينسخها في الملف Sal.xls ثم يغلقه ويفتح التالي الكود Sub collect_data() ' rep_N = InputBox("Number of Reports from 001 to ?") For i = 1 To rep_N a = "Report" & Format(i, "00#") & ".xls" Workbooks.Open Filename:=a Sheets(1).Select sign = [c1000].End(xlUp).Value Range([a3], [a3].End(xlToRight).End(xlDown)).Select rr = Selection.Rows.Count Selection.Copy Workbooks("Sal.xls").Activate Sheets(2).Select [A10000].End(xlUp).Offset(2, 0).Select ActiveSheet.Paste ActiveCell.Select For j = 1 To rr Selection.Offset(j - 1, 3) = sign Next j Workbooks(a).Close Next i End Sub تفضل الملف ايضا Sal.rar

أخي الفاضل آسف وقتي ضيق جد وأنت لم ترسل أسئلتك كلها مرة واحدة المهم أرجو ممن لديه بعض الوقت من الأخوة يتقدم بإكمال طلباتك

السلام عليكم أخي الكريم لعلك تقصد ستيني وهي نسبة إلي 60 حيث جري العرف علي قراءة الزوايا بالتقدير الستيني مثل الساعة فيقال مثلا 50:40:25 أي خمسون درجة وأربعون دقيقة و25ثانية أما في المعاملات والدوال الرياضية فلابد للرجوع للتقدير الدائري إن أردت التعبير عن الزوايا حتي في الإكسل أيضا ، للعلم الزاوية الصحيحة (1) بالتقدير للدائري هي الزاوية التي يتساوي طول القوس المقابل لها مع طول نصف القطر وهي بالتقدير الستيني = 57:15:45 تقريبا وهي نفسها = 57.2958 بالصيغة العشرية المهم النسبة التقريبية (ط) بالإنجليزية باي بالإكسل =PI() هذه النسبة تقابل الزاوية المستقيمة 180 لذلك لتحويل أي زاوية من التقدير الستيني للدائري تضربها في (ط) وتقسمها علي 180 فمن المعروف مثلا للمهتمين بالرياضة أن جا30 درجة = 0.5 لكنك إذا أردت الحصول علي جا 30 درجة في الإكسل فلابد ان تحول الـ 30 درجة بالتقدير الستيني للدائري ثم تطبق عليه دالة الـ جا أي أن جا(30) بالإكسل =sin(30*PI()/180) طبعا إذا كان التانك مملؤ إلي النصف تماما فهذا يعني ان الزاوية =180 أي =(ط) أي =PI()

بالمعادلات هتكون صعبة كثير ولكن بالأكواد ممكن

السلام عليكم أخي عبدالله تفضل المرفق وبه شرح أرجو أن أكون فهمت المطلوب تحياتي Cylender_Tank.rar

السلام عليكم السؤال الثالث هذا السؤال صعب شوية ويحتاج لتركيب عدة دوال أو بالأكواد بالمعادلات كما بالمرفق وقد بدلت الموظف 76002 إلي 76040 للتجربة أنظر الخلية N46 في الشييت CARD وبها المعادلة =OFFSET('24'!$F$7,0,MATCH(24,INDIRECT(ADDRESS(MATCH($L$27,'24'!B:B,0),6,,,24)&":"&ADDRESS(MATCH($L$27,'24'!B:B,0),26)))-1) إستبدلتها بالخلية الأولي حيث أن الشيتات المتاحة للأيام تبدأ من 21 THE LIST WORK .rar

السلام عليكم السؤال الثاني من قائمة Tools Options View ثم إلغي العلامة من Formula Bar أنظر الصورة

السلام عليكم أخي الحبيب د/خالد أحبك الله الذي أحببتني فيه أخي الموضوع أصعب من ان تنقل الكود وتعدل عليه قليلا آسف لاأريد إحباطك ولا أنكر تقدمك الكبير ولكن يبدو من الكود الذي أرسلته أنك تريد الحصول علي رتبة المجموع بالنسبة لباقي المجاميع فالأول لابد من الحصول علي هذه المجاميع لذلك في الأول لابد أن تعمل دالة مجموع ثم هذه الدالة للحصول علي رتبة هذا المجموع بالنسبة لباقي المجاميع راجع مثلا الملف المرفق في المشاركة #24 من هذا الموضوع ، وأنت طبعا ادري مني في هذا لكن لابد أن تتعلم جيدا كل معادلة في الملف قبل أن تحولها أو تحوله إلي دالة أو كود نقلت لك من هذا الملف في المشاركة #24 معادلة المجموع لتعينك علي عمل الدالة في المرفق بداية فقط لشرح كيف يعمل الكود ووضعت فيه الكود الذي أرسلته أنت بأخطاؤه كما هو تستطيع الإكمال وإكتشاف الأخطاء مثلا إذا بدأت حلقة For ...Next لمتغير p فلابد أن يكون آخر الحلقة نفس المتغير وهذا احد أخطاء الكود أنظر المرفق وحاول ثانية شرح الكود.rar

السلام عليكم تفضل أخي المرفق به حل لأول سؤال فقط الأيام والجمعة اليوم بالتنسيق والدالة Date واللون الأحمر بالتنسيق الشرطي غير رقم الشهر أو السنة وستري النتيجة وأضفت أيضا تنسيق شرطي جديد لعدم إظهار الأيام التي تزيد عن الشهر الحالي في حالة أنه أقل من 31 Month_Dates.rar

السلام عليكم أخي العزيز مرحبا بك بين إخوانك للرفع لابد من ضغط الملف بأي برنامج ضغط WINRAR أو WINZIP

اكتشفت اخطاء بسيطة صلحتها وهي 1 السطر السابع من أسفل (في أواخر الدالة) s = bst.Row - st.Row + 1 وليس s = bst.Row - st.Row + p 2 السطر العاشر من أسفل (في أواخر الدالة) z(p) = (clen_mx(p) + (clen_mx(p) / wp)) + 0.00009 + Asbaqya_cof(p) + qur3a(p) وليس z(p) = (clen_mx(p) + (clen(p) / wp)) + 0.00009 + Asbaqya_cof(p) + qur3a(p) وإليك الكود الصحيح للدالة بعد التعديلات Function clen_rnk(bst, w As Range) As Variant Dim ss(99), clen(99), clen_mx(99), Asbaqya(99), qur3a(99), Asbaqya_cof(99), z(99) As Variant, st, fn As Range Set fn = [a1000].End(xlUp) Set st = fn.End(xlUp) play_N = WorksheetFunction.CountA(Range(st, fn)) For p = 1 To play_N For i = 1 To 3 clen(i) = Cells(st.Row, bst.Column).Offset(p - 1, i - 4) If WorksheetFunction.IsNumber(clen(i)) Then clen(i + 3) = clen(i) + (3 - i) * 0.1 Else clen(i + 3) = 0 End If If clen_mx(p) < clen(i + 3) Then clen_mx(p) = clen(i + 3) 'Asbaqya If clen(i) > "X" Then clen(i + 6) = Right(clen(i), Len(clen(i)) - 1) Else: clen(i + 6) = 0 End If If Asbaqya(p) < clen(i + 6) Then Asbaqya(p) = clen(i + 6) Next i mx_qur3a = WorksheetFunction.Max(Range("A:A")) qur3a(p) = (mx_qur3a - Cells(st.Row + p - 1, 1).Value) / mx_qur3a / 100 If mx_Asbaqya < Asbaqya(p) Then mx_Asbaqya = Asbaqya(p) Next p 'calculate each z(p) For p = 1 To play_N wp = Cells(st.Row - 1 + p, w.Column).Value If mx_Asbaqya = clen_mx(p) Then Asbaqya_cof(p) = -clen_mx(p) / 4 / wp Else: Asbaqya_cof(p) = 0 End If z(p) = (clen_mx(p) + (clen_mx(p) / wp)) + 0.00009 + Asbaqya_cof(p) + qur3a(p) Next p 'calculate Rank of bst s = bst.Row - st.Row + 1 If z(s) < 1 Then clen_rnk = "X": Exit Function rnk = 1 ' assume For p = 1 To play_N If z(p) > z(s) Then rnk = rnk + 1 Next p clen_rnk = rnk End Function وإليك المرفق به الدوال الأربعة تعمل جيدا best_khatf - khatf_rnk - best_clen- clen_rnk ولايبقي إلا موضوع فئات الوزن وإلي لقاء آخر sphinx10.rar

السلام عليكم أعتقد أنها تعمل ولكن لابد من بعض الإحتياطات قد تكون وقعت في إحداها مثل أول سطر Function clen_rnk(bst, w As Range) As Variant هذا يعني أن تشير بالماوس لــ bst المذكورة في أول الدالة تشير لأفضل النطر ، و تشير بالماوس لــ w المذكورة في الشق الثاني من الدالة للوزن لابد أن يكون ترتيب الجدول كما كان بالسابق أي 3 أعمدة للكلين يتبعها 3 أعمدة لـ افضل النطر - ترتيب النطر - نقاط االنطر أن تضع هذه الدالة طبعا في عمود ترتيب النطر وليس في مكان آخر وكما سبق يفترض أن bst المذكورة في أول الدالة تشير لأفضل النطر لاحظ السطر من السادس إلي الثامن For j = 1 To play_N For i = 1 To 3 khtf(i) = Cells(st.Row, bst.Column).Offset(j - 1, i - 4) ستلاحظ أنه يعتمد تعرف الدالة علي رقم أفضل النطر لكل لاعب ، يعتمد علي أن يكون عمود أفضل النطر هذا تالي مباشرة لثلاث أعمدة بها محاولات النطر عموما سأجربها وأخبرك

السلام عليكم أختي الكريمة يوجد معادلات طويلة كالتي في الورقة samry3 كهذه =SUMPRODUCT((Jun!Q3:Q502=A30)*(Jun!R3:R502=B29))+SUMPRODUCT((Jul!Q3:Q502=A30)*(Jul!R3:R502=B29))+SUMPRODUCT((Aug!Q3:Q502=A30)*(Aug!R3:R502=B29))+SUMPRODUCT((Sep!Q3:Q502=A30)*(Sep!R3:R502=B29))+SUMPRODUCT((Oct!Q3:Q502=A30)*(Oct!R3:R502=B29))+SUMPRODUCT((Nov!Q3:Q502=A30)*(Nov!R3:R502=B29))+SUMPRODUCT((Dec!Q3:Q502=A30)*(Dec!R3:R502=B29)) ومتكررة مئات المرات وأعتقد أيضا أن بالأكواد مشاكل Loops أو بأكواد الأحداث أو الفورم للأسف لاأستطيع الحكم جيدا لأن الجهاز عندي لايقرا اللغة العربية التي داخل الأكواد ولكن لابد من تخفيف مثل هذا التحميل لكل حركة من حركات المستخدم عموما هو ليس بطيئا جدا علي الجهاز عندي فقط يأخذ بعض الوقت عند الإغلاق

السلام عليكم لم أفهم السؤال إن كنت تريدين إخفاء الأعمدة: قفي عليها من الأعلي ثم كليك يمين بالماوس ثم إخفاء (أو Hide) أنظري المرفق hide_Column.rar

السلام عليكم أخي الكريم جميل منك سرعة التطبيق اليوم مع الدالة الثانية (تفصيل طبعا) في الموضوع دالة ترتيب الخطف وسميتها khatf_rnk مرفق ملف به التطبيق بلا أعمدة إضافية للأسبقية والقرعة ومعامل الوزن ومعامل الخطف .. إلخ الدلة من شقين (افضل خطف) ، (الوزن) تكتبها وتفتح قوس وتشير بالماوس علي الشق الأول ثم فاصلة ثم الشق الثاني) أتركك لتهضمها علي مهلك لننتقل للجزء التالي وهذا هو الكود Function khatf_rnk(bst, w As Range) As Variant Dim ss(99), khtf(99), khtf_mx(99), Asbaqya(99), qur3a(99), Asbaqya_cof(99), z(99) As Variant, st, fn As Range Set fn = [a1000].End(xlUp) Set st = fn.End(xlUp) play_N = WorksheetFunction.CountA(Range(st, fn)) For j = 1 To play_N For i = 1 To 3 khtf(i) = Cells(st.Row, bst.Column).Offset(j - 1, i - 4) If WorksheetFunction.IsNumber(khtf(i)) Then khtf(i + 3) = khtf(i) + (3 - i) * 0.1 Else khtf(i + 3) = 0 End If If khtf_mx(j) < khtf(i + 3) Then khtf_mx(j) = khtf(i + 3) 'Asbaqya If khtf(i) > "X" Then khtf(i + 6) = Right(khtf(i), Len(khtf(i)) - 1) Else: khtf(i + 6) = 0 End If If Asbaqya(j) < khtf(i + 6) Then Asbaqya(j) = khtf(i + 6) Next i mx_qur3a = WorksheetFunction.Max(Range("A:A")) qur3a(j) = (mx_qur3a - Cells(st.Row + j - 1, 1).Value) / mx_qur3a / 100 If mx_Asbaqya < Asbaqya(j) Then mx_Asbaqya = Asbaqya(j) Next j 'calculate each z(j) For j = 1 To play_N wj = Cells(st.Row - 1 + j, w.Column).Value If mx_Asbaqya = khtf_mx(j) Then Asbaqya_cof(j) = -khtf_mx(j) / 4 / wj Else: Asbaqya_cof(j) = 0 End If z(j) = (khtf_mx(j) + (khtf_mx(j) / wj)) + 0.00009 + Asbaqya_cof(j) + qur3a(j) Next j 'calculate Rank of bst s = bst.Row - st.Row + 1 If z(s) < 1 Then khatf_rnk = "X": Exit Function rnk = 1 ' assume For j = 1 To play_N If z(j) > z(s) Then rnk = rnk + 1 Next j khatf_rnk = rnk End Function sphinx9.rar

السلام عليكم أيضا بالنسبة للملف الثاني : Book1.xls فكما ذكرتي أنت لتفادي ذلك إذهبي لأصل المعادلات في الورقة الأولي Jun ستجدي الخطأ في العمود D اقصى تاريخ للاصلاح حيث يضع "" إن لم يوجد تاريخ البلاغ وهذه "" نص ، إستبدليها بصفر مع عمل تنسيق شرطي لإخفاء النتيجة إذا كانت صفرا في هذا العمود أنظري المرفق Book1.rar