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

[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

 

[ابو جودي]

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

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

Expand  

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

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]

  في 31‏/5‏/2023 at 13:36, ابو جودي said:

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

Expand  

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

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

 

[jo_2010]

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

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

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

aaa.accdbFetching info...

[Eng.Qassim]

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

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

 

aaa.rarFetching info...

[AbuuAhmed]

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

 

[ابو جودي]

  في 31‏/5‏/2023 at 15:59, AbuuAhmed said:

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

Expand  

ههههههههه

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

[jo_2010]

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

[AbuuAhmed]

  في 1‏/6‏/2023 at 06:19, ابو جودي said:

ههههههههه

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

Expand  

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

[ابو جودي]

  في 1‏/6‏/2023 at 07:37, AbuuAhmed said:

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

Expand  

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

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

Ceiling function (2).mdbFetching info...

[AbuuAhmed]

  في 1‏/6‏/2023 at 09:31, ابو جودي said:

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

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

Expand  

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

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.xlsmFetching info...

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

[ابو جودي]

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

  في 31‏/5‏/2023 at 15:59, AbuuAhmed said:

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

 

Expand  

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

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

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

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

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

Expand  

 

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

[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.xlsmFetching info...

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