دوال التقريب

[عبد الله-بلال]

السلام عليكم إخواني أريد دالة تقرب للأعلى في أكسس في حقل محسوب فمثلا : ما دون 0.5 تعطيني نصف و ما فوق 0.5 يعطيني 1 و جزاكم الله كل الخير

[ابوخليل]

في وحدة نمطية عامة الصق هذه الدالة

Public Function RoundNmber(Rou As Double) As Double
    Dim i As Double
    i = Val(Rou)
    If i < CInt(i) Then
        i = CInt(i)
    ElseIf (i - CInt(i)) > 0 Then
        i = CInt(i) + 0.5
    End If
    RoundNmber = i
End Function

تناديها من اي مكان في الاستعلام او النموذج او التقرير'

 =RoundNmber([yourText])

 

[عبد الله-بلال]

أبو خليل السلام عليكم و رحمة الله تعالى و بركاته و جزاكم الله خيرا على هذا الرد السريع .  تحياتي

[Eng.Qassim]

مشاركة مع استاذي @ابوخليل

Public Function RoundNmber(Rou As Double) As Double
    If Rou - Int(Rou) < 0.5 Then
        RoundNmber = Int(Rou) + 0.5
    Else
        RoundNmber = Int(Rou) + 1
    End If
End Function

 

[Foksh]

مشاركة مع الاساتذة ومعلمنا الفاضل ..

Private Sub Text0_AfterUpdate()
Text0 = Int(Text0) + IIf(Text0 - Int(Text0) <= 0.5, 0.5, 1)
End Sub

وهذه الفكرة من خلا الاستعلام :-

RoundedValue: Int([اسم الحقل]) + IIf([اسم الحقل] - Int([اسم الحقل]) <= 0.5, 0.5, 1)

 

تم تعديل الإثنين at 09:57 بواسطه Foksh
اضافة فكرة من خلال الاستعلام

[عبد الله-بلال]

السلام عليكم يا أساتذتي الأعزاء جزاكم الله كل الخير . عندي استفسار لأبو خليل : لقد جربت الدالة هي تعمل مع 0.5 فقط بمعنى إذا كان الرقم مثلا 8.25 تعطينا 9 و هي في الواجب تعطينا 8.50 يعني كل ما فوق 0.50 يكون صحيحا و أما دون 0.50 تعطينا بالخطأ : فمثلا : 7.75 تعطي 8 و هذا صحيح و أما 7.26 تعطينا كذلك 8 و هذا خطأ .فالواجب تعطينا 7.50 . أرجو أن أكون وفقت في إبراز الفكرة و شكرا

[عبد الله-بلال]

السلام عليكم إخواني 

أريد المشاركة مع أستاذي الفاضل Eng.Qassim 

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

Public Function RoundNmber(Rou As Double) As Double
    If Rou - Int(Rou) = 0 Then
        RoundNmber = Int(Rou)
        Else
        If Rou - Int(Rou) <= 0.5 Then
           RoundNmber = Int(Rou) + 0.5
        Else
        
        RoundNmber = Int(Rou) + 1
    End If
    End If
End Function

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

[ابوخليل]

1 ساعه مضت, عبد الله-بلال said:

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

الحمد لله

[Eng.Qassim]

الحمد لله 

 

[AbuuAhmed]

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

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

 

 

تم تعديل الثلاثاء at 07:08 بواسطه AbuuAhmed

[ابوخليل]

1 ساعه مضت, AbuuAhmed said:

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

 

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

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

[AbuuAhmed]

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
جربوها.

[ابو جودي]

9 ساعات مضت, AbuuAhmed 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
جربوها.

انا اللى كنت كاتب الكود ده 👆

وتجد مزيد من الشرح فى هذا الموضوع 

 

[ابو جودي]

 طيب ومشاركة مع اساتذتى العظماء هذه فكرتى المتواضعة
 

' ---------------------------------
' Custom Rounding Function: Rounds a number based on fractional parts
' Parameters:
'   - numValue (Double): The number to round.
' Returns:
'   - (Double): The custom rounded value.
' ---------------------------------
Public Function CustomRound(ByVal numValue As Double) As Double
    On Error GoTo ErrorHandler

    Dim wholePart As Double
    Dim fractionalPart As Double
    
    ' Extract the whole part and the fractional part of the number
    wholePart = Int(numValue)
    fractionalPart = numValue - wholePart
    
    ' Custom rounding logic
    If fractionalPart < 0.5 Then
        CustomRound = wholePart + 0.5 ' Round to 0.5
    Else
        CustomRound = wholePart + 1 ' Round to the next whole number
    End If

    Exit Function

ErrorHandler:
    MsgBox "Error in CustomRound function: " & Err.Description, vbCritical, "Error"
    CustomRound = 0 ' Return 0 in case of an error
End Function

 

CustomRound.mdb

[AbuuAhmed]

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

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

CeilingFunction4Access_04.xlsm

[ابو جودي]

4 دقائق مضت, AbuuAhmed said:

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

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

[AbuuAhmed]

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

اقتباس

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

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

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

CustomCeiling_01.xlsm

[Foksh]

2 ساعات مضت, AbuuAhmed said:

مشاركتي الأخيرة في هذا الموضوع

بناءً على ما تفضلتم به أستاذنا الكبير @AbuuAhmed ، فأنه وجب تعديل اقتراحي ليصبح كالآتي :-

Private Sub Text0_AfterUpdate()
    Dim absValue As Double
    absValue = Abs(Text0)
    Text0 = Sgn(Text0) * (Int(absValue) + IIf(absValue - Int(absValue) <= 0.5, 0.5, 1))
End Sub

 

تم تعديل الأربعاء at 14:39 بواسطه Foksh

[أبو إبراهيم الغامدي]

أهلا بكم..

في اعتقادي أن أكسس لديه أدوات تقوم بالتقريب! لكن الإشكال متي وكيف يمكن استخدام التقريب؟!

الطريقة الأولى

> في تصميم الجدول يمكن التقريب بوضع صفر في خصيصة منازل الفاصلة العشرية..(مع بيانات العُملة، أو الرقمية ذات الفاصلة العشرية)..

> في تصميم الاستعلام أو النموذج أو التقرير.. نتبع نفس الخطوات..

 

الطريقة الثانية استخدام التوابع 

(...,FormatCurrency(Expression, [NumDigitsAfterDecimal As Long = -1]

(...,FormatNumber(Expression, [NumDigitsAfterDecimal As Long = -1]

 

الطريقة الثالثة استخدام التابع

Round(Number, [NumDigitsAfterDecimal As Long])

> هذه التابع له محددان: الرقم المراد تقريبه، وعدد المنازل بعد الفاصلة..

> المحدد الثاني إختياري: إذا تم تجاهله أو وضع الصفر؛ فإنه يقرب إلى الواحد.. مثال: تقرب الرقم 1.50 إلى 2.00

> يعيب هذه التابع أنه يقرب 0.50 إلى 0.00 ، وللتخلص من هذا العيب نضرب المحدد الأول في 1.01

 

استخدام هذه الحلول في الاستعلام

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

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

 

في المثال المرفق: راجع الاستعلامات الثلاث في وضع التصميم لترى الفرق..

dbTestCurrency.accdb

 

 

 

[عبدالقدوس48]

Round([استعمل الرقم مراد تقريبه]++0,0000002;2)

[AbuuAhmed]

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

[Foksh]

استاذنا @AbuuAhmed ، يسعدنا دائما زياراتكم في قسمنا 🤗 .

 

بالنسبة لي اعتمدت هذه الفكرة التي طرحتها وتم تعديلها سابقاً ، كونها لا تؤثر على مجرى العمليات الحسابية ( اذا اعتمدنا على مساواة القيمة الحقيقية والظاهرة من خلال التنسيقات ) . لذا ذهبت الى تحويل الكود الى دالة عامة كالآتي :-

Public Function RoundCustom(ByVal inputValue As Double) As Double
    Dim absValue As Double
    absValue = Abs(inputValue)
    RoundCustom = Sgn(inputValue) * (Int(absValue) + IIf(absValue - Int(absValue) <= 0.5, 0.5, 1))
End Function

وللإستدعاء بشكل منفرد لكل عنصر نصي ( مربع نص ) في حدث بعد التحديث مثلاً :-

Private Sub Text0_AfterUpdate()
    Text0 = RoundCustom(Text0)
End Sub

أما من خلال الإستعلام ، فلنا حاجة للإستدعاء كالآتي :-

SELECT RoundCustom([اسم_الحقل]) AS RoundedValue FROM اسم الجدول;

كمثال للتوضيح :-

SELECT RoundCustom([Salary]) AS RoundedSalary FROM Employees;

 

التعليق هو أطراف أفكار ليس إلا .. 😅 رغم ان الموضوع قد تم حسمه وإغلاقه بأفضل إجابة 😁 .

[AbuuAhmed]

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

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

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

[AbuuAhmed]

2 ساعات مضت, Foksh said:

يسعدنا دائما زياراتكم في قسمنا 🤗

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

[ابوخليل]

13 ساعات مضت, AbuuAhmed said:

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

افضل اجابة يراد منها غالبا اغلاق الموضوع وأن السائل حصل على مطلوبه

والأهم انها تحقق حلا صحيحا حسب الطلب .. وأكرر .. حسب الطلب .. وليس التوسع في الحلول

هنا وبعد مراجعة الاجابات أرى ان اخصر اجابة حققت للسائل طلبه هي اجابته الاخيرة وتعديله على حل الاستاذ قاسم

....

اخي وحبيبي ابو احمد اتمنى ان لا تكون هذه الخاصية ( افضل اجابة) متلازمة عندك

طنش تعش .. حيث لا قيمة لها امام الباحث المتعلم الذي يبحث عن تفاصيل اكثر وادق

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

.. ختاما هذه الخاصية يقصد بها ان السائل حصل على مطلوبه . بمعنى انها هي الاجابة التي اعتمدها السائل وحققت مطلوبه

وليست المسألة مقارنة بين الحلول المطروحة

فانا لما اتصفح المواضيع لا ادخل على المواضيع التي امامها علامة الصح الخضراء ..