AbuuAhmed

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

أكثر الأخطاء حصلت بسببين:
الأول: أن أكثركم ذهب لمعالجة الكسر إذا كان أصغر من نصف أو (أكبر أو يساوي نصف) ولكن غفل عن الكسر إذا كان صفرا والذي لا يحتاج إلى معالجة.
الآخر: عدم اختبار دوالكم مع الأرقام السالبة، وهذه تحتاج إلى مزيد من العناية والحرص ومعرفة تامة بالتعامل مع دالتي int و fix أو trunc في لغات أخرى.

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

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

مشاركتي الأخيرة في هذا الموضوع
ملخص مقارنة لجميع المشاركات في ملف إكسل وصورة.

اقتباس

لكن دالة CEILING اساسا موجودة بالاكسل من ضمن الدوال المضمنه به ولم تكن تحتاج الى كتابة اى اكواد

الدالة المذكورة ومثيلاتها الثلاث صممت للأكسس مع تطابق تام مع دوال الإكسل بقدر الاستطاعة، وملف الإكسل ما هو إلا وسيلة للمقارنة فقط.

موفقين جميعا، أنا لم أغادر أوفيسنا، ومتواجد في منتدى الإكسل لمن يريد متابعتي.

CustomCeiling_01.xlsm

كنت أبحث عن موضوع سابق لي لعمل بعض الدوال شبيهة للإكسل ووجدتها بعد وقت طويل.

استخدمت أحد الملفات وزدت عليه دالتك، أرجو الاطلاع.

CeilingFunction4Access_04.xlsm

1 ساعه مضت, ابوخليل said:

ا هلا ابو احمد  .. عودا حميدا 

من طول الغيبات جاب الغنايم 

يا هلا بيك وشكرا لك.

وجدت في جهازي دالة بنفس اسم دالة الإكسل وأداؤها أفضل من دالة الإكسل حيث في الأرقام السالبة لا يحتاج أن يكون الكسر (Factor) سالب لتعطي نتائج صحيحة.
الدالة ليست من عملي، وزدت بداية اسمها حرفين vb لتمييزها عن دالة الإكسل.
 

Public Function vbCeiling(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
    ' X is the value you want to round
    ' is the multiple to which you want to round
    vbCeiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function

لهذا الموضوع تكون قيم Factor نصف أي 0.5
جربوها.

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

Function myRound(ByVal Expression As Double) As Double
  Dim SgnVal As Integer
  Dim frac As Double
  
  SgnVal = Sgn(Expression)
  Expression = Abs(Expression)
  frac = Expression - Fix(Expression)
  
  If frac >= 0.5 Then frac = 1
  If frac > 0 And frac < 0.5 Then frac = 0.5
  
  myRound = (Fix(Expression) + frac) * SgnVal
End Function

تعديلي كان في العمود (J) فقط.

المرفق حسب فهمي لمطلبك:

DC_02.xlsx

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

في 20‏/9‏/2024 at 01:25, AbuuAhmed said:

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

توزيع الطلاب_04.xlsm 23.56 kB · 34 downloads

هناك هفوة، لتصحيحها بدلوا:
 

    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

في 21‏/12‏/2024 at 18:44, spyhearts said:

امل المساعدة في الملف المرفق جزاكم الله كل خير

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

معادلة معرفة المتبقي من الأيام:
 

تاريخ انتهاء المستنيد - 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

جرب هذه المحاولة ربما فيها الحل
 

Zone-02-1copy_01.xlsm

استفسار:

هل أحداثيات مساحية تعني أحداث مواقع جغرافية؟

وإذا كان الجواب بنعم هل هذه الأرقام عبارة عن درجات قوسية؟ أقصد درجة ودقيقة وثانية.