تقريب الارقام

[jo_2010]

السادة الخبراء الافاضل 

تحية لكم وللمنتدى الرائع الذى اضاف لى الكثير من المعلومات

عندى سؤال 

مجموعة من الارقام  عبارة عن عملة 21.5 او 23 او 21 عاوز عملهم تقريب بحيث يكونوا 25

وبالمثل 19 و18و17و16 تصبح 20 بمعنى تقريب الارقام بحيث يكون رقم صحبح يبدا 0 او 5

ملحوظة الارقام كثير مش دول فقط فية ارقام بتصل الى 2753 اريدة يكون 2755 وهكذا

[ابو جودي]

اتفضل يا سيدى 

اولا قم بعمل وحدة نمطية وضع بها الاكواد الاتية

Public Function Ceiling(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
    Ceiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function

Public Function Floor(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
    Floor = Int(X / Factor) * Factor
End Function

استدعاء الدالة كالاتى

Ceiling([SourceNumber],variableOfFixedNumber)

التقريب الى الرقم الصحيح 5 يمكنك تغسييره الى ما تريد وليكن 10  او 20 او اى عدد تريده

 

--------

الطريقة الثانية

ولكن لن تستطيع تغيير الرقم الذى تريد التقريب اليه

استخدم الكود الاتى مباشرة 

Int(-0.2*[SourceNumber])/-0.2

 

[AbuuAhmed]

دالة على السريع، جربها ويمكننا تطويرها بعد التجارب:
 

Function myRound(ByVal Num As Double) As Double
    Dim Frac As Double
    
    Num = Num / 10
    Frac = Num - Int(Num)
    Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 10, 5))
    
    myRound = Int(Num) * 10 + Frac
End Function

 

[ابو جودي]

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

دالة على السريع، جربها ويمكننا تطويرها بعد التجارب:

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

Function myRound(ByVal Num As Double, Optional ByVal Factor As Double = 1) As Double
    Dim Frac As Double
    
    Num = Num / Factor
    Frac = Num - Int(Num)
    Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, Factor, Factor))
    
    myRound = Int(Num) * Factor + Frac
End Function

على ان يتم استدعاء الوتين من خلال 

myRound([SourceNumber],variableOfFixedNumber)

 

[AbuuAhmed]

2 ساعات مضت, ابو جودي said:

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

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

    Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 2, 1)) * Factor

 

[jo_2010]

اساتذتى الافاضل

امكانياتى متواضعى جدا فى الاكسيس ومش عارف الاكواد دى استخدمها ازاى 

اليكم جدول بة الاسعار اريد استعلام لجعل الاسعار كما اشترت سابقا اليكم الجدول للتعديل وصورة لما اريد

aaa.accdb

[Eng.Qassim]

استخدمت لك كود استاذ ابو احمد 

اما كود استاذ محمد عصام فيحتاج الى فاكتور في النموذج 

 

aaa.rar

[AbuuAhmed]

كنت قد كتبت 4 دوال سابقا، ولكني نسيتها، ولو تذكرتها لاكتفيت بها 🙂 

 

[ابو جودي]

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

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

ههههههههه

طب ع الاقل جرب قبل لا تضع الرد

[jo_2010]

الخبراء الافاضل شكرا لكم جميعا على الاهتمام بحل مشكلتى خالص الشكر للجميع 

[AbuuAhmed]

منذ ساعه, ابو جودي said:

ههههههههه

طب ع الاقل جرب قبل لا تضع الرد

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

[ابو جودي]

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

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

 استاذى الجليل

اليكم التطبيق

Ceiling function (2).mdb

[AbuuAhmed]

منذ ساعه, ابو جودي said:

استاذى الجليل

اليكم التطبيق

أنت قمت بتعديل مشاركتك وباستخدام صلاحياتك الإدارية!! بحيث لا تظهر ملاحظة التعديل 🙂 
هذا تعديلك الأول والذي أنا علقت عليه:
 

Function myRound2(ByVal Num As Double, Optional ByVal Factor As Double = 1) As Double
    Dim Frac As Double
    
    Num = Num / 10
    Frac = Num - Int(Num)
    Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 10, Factor))
    
    myRound2 = Int(Num) * 10 + Frac
End Function

وهذا ملف اكسل به المقارنات 🙂 

 

Test4myRoundFunctions_02.xlsm

تم تعديل يونيو 1, 2023 بواسطه AbuuAhmed
تغيير المرفق

[ابو جودي]

اولا انا فعلا عدلت بس مش بعد مشاركة حضرتك ممكن حضرتك لما قلت 

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

    Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 2, 1)) * Factor

 

ولما عدلت كان التعديل على السطر اللى تحت يا افندم مش ع السطر ده من الكود 

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

حضرتك وضعت الكود وقلت يمكن تطويرها 

في 31‏/5‏/2023 at 14:38, AbuuAhmed said:

دالة على السريع، جربها ويمكننا تطويرها بعد التجارب:

 

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

[AbuuAhmed]

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

 

'دالة من عمل أبي أحمد وأبي جودي
Function vbCEILING2(ByVal Num As Double, Optional ByVal Significance As Double = 1) As Double
    Dim Frac As Double
    
    Num = Num / Significance
    Frac = Num - Int(Num)
    
    vbCEILING2 = Int(Num) * Significance + IIf(Frac = 0, 0, Significance)
End Function

 

 

Test4myRoundFunctions_04.xlsm

تم تعديل يونيو 1, 2023 بواسطه AbuuAhmed