AbuuAhmed

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

هناك هفوة، لتصحيحها بدلوا: For row = 2 To lRow Cells(row, 3) = (row - 2) Mod 5 + 1 Next row إلى: For row = 2 To lRow Cells(row, 3) = (row - 2) Mod Classes + 1 Next row

الليلة في وقت متأخر إن شاء اللهز

معادلة معرفة المتبقي من الأيام: تاريخ انتهاء المستنيد - Today()

اطلع على المرفق التالي فبه احتمالين ربما الآخر يلامس مطلبك. ترحيل_04.xlsx

لا أفهم الحاجة لموضوع الثلاثين يوم هذه محاولة بدون "العبث" بنتائج التاريخ ترحيل_03.xlsx

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

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

هدية مني لكم هذا كود يختصر الوقت لمستخدمي النافذة الفورية حيث يمسح كامل النصوص/المخرجات السابقة قبل أي إرسال نصوص أو مخرجات جديدة جربوه وزودونا بأي مشاكل تواجهونها للتعديل عليه. Sub DebugClear() 'AbuuAhmed 2024/11/01 Dim WshShell As Object Set WshShell = CreateObject("WScript.Shell") With WshShell .SendKeys "^g", True .SendKeys "^a", True .SendKeys "{DEL}", True End With Set WshShell = Nothing End Sub

أكواد الترتيب هي ناتج عملية تسجيل للماكرو لم أنتبه أنه يحدد آخر سطر مع أن في التسجيل كنت أختار كامل العمود. وقد تم التعديل على الكود ليتعامل مع آخر سطر بالزيادة أو النقصان. توزيع الطلاب_04.xlsm

مساهمة ثالثة مني إصافة إلى المساهمتين السابقتين لزميلاي. توزيع الطلاب_03.xlsm

جرب محاولتي الأولى AmrVacations_01.xlsx

إضافة فكرة أخر للتقييم Zone-02-1copy_02.xlsm

قدم لنا أي فكرة ممكن نحولها إلى أكواد ربما لو يكون هناك توزيع نسب للأبعاد يكون البحث أقرب لمطلبك مثلا N تعطيه 50% والـ E 30% والـ Z يأخذ 20% وهكذا. أنا قدمت اجتهادي وننتظر من الزملاء تقديم أفكار أخرى ويمكنك كذلك عرض السؤال على منتدى أكسس فلديهم الكثير ممن يجيد كتابة الأكواد كما خبراء الاكسل.

تم التعديل على الكود للتسريع فقط. Function getAvgPer(N1 As Double, E1 As Double, Z1 As Double, _ N2 As Double, E2 As Double, Z2 As Double) As Double getAvgPer = (IIf(N1 < N2, N1 / N2, N2 / N1) + _ IIf(E1 < E2, E1 / E2, E2 / E1) + _ IIf(Z1 < Z2, Z1 / Z2, Z2 / Z1)) _ / 3 End Function Function getClosestID(N1 As Double, E1 As Double, Z1 As Double) As Double Dim Sht As Worksheet Dim row As Long, lRow As Long Dim ClosestVal As Double, CurrVal As Double Dim ClosestID As Long Application.ScreenUpdating = False Set Sht = Sheets("1") With Sht lRow = .Range("A1").End(xlDown).row For row = 1 To lRow CurrVal = getAvgPer(N1, E1, Z1, .Cells(row, 2), .Cells(row, 3), .Cells(row, 4)) If CurrVal > ClosestVal Then ClosestVal = CurrVal ClosestID = .Cells(row, 1) If ClosestVal = 1 Then Exit For End If Next row End With getClosestID = ClosestID Set Sht = Nothing Application.ScreenUpdating = True End Function