طرق مختلفة للتقريب

[محمد طاهر عرفه]

المثال المرفق ، فضلا عن استخدام الدالة ROUND يوجد دالتان للتقريب

الاولي تقرب دائما الي الاعلي

و الثانية تقرب بدرجة معينة

Myround.rar

[محمد طاهر عرفه]

تم تعديل الدالة بناء علي موضوع فى قسم الأكسس ، و التعديل من أجل أخذ الأرقام السالبة فى الاعتبار

Function ROUNDTO(MYNO As Double, MyFraction As Double)

' to round up or down with a certain value

Dim MYBASE As Double, MYREM As Double


If Abs(Round(MyFraction, 2)) <= 0 Then

ROUNDTO = MYNO

Exit Function

End If


Dim neg As Boolean

neg = False

If MYNO < 0 Then neg = True


MYNO = Abs(MYNO * 100)

MyFraction = MyFraction * 100


MYREM = MYNO Mod MyFraction

'MsgBox "rem : " & MYREM

MYBASE = MYNO - MYREM

'MsgBox "Base : " & MYBASE


If MYREM > 0 Then

If MYREM > MyFraction / 2 Then

ROUNDTO = MYBASE + MyFraction

Else

ROUNDTO = MYBASE

End If


Else

ROUNDTO = MYNO

End If

ROUNDTO = ROUNDTO / 100

If neg = True Then ROUNDTO = -ROUNDTO

End Function