دوال التقريب

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

السلام عليكم إخواني أريد دالة تقرب للأعلى في أكسس في حقل محسوب فمثلا : ما دون 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)

 

تم تعديل بالامس في 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

 

 

تم تعديل منذ 11 ساعات بواسطه 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
جربوها.