عبد الله-بلال قام بنشر السبت at 21:58 قام بنشر السبت at 21:58 السلام عليكم إخواني أريد دالة تقرب للأعلى في أكسس في حقل محسوب فمثلا : ما دون 0.5 تعطيني نصف و ما فوق 0.5 يعطيني 1 و جزاكم الله كل الخير
ابوخليل قام بنشر السبت at 23:57 قام بنشر السبت at 23:57 في وحدة نمطية عامة الصق هذه الدالة 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]) 1
عبد الله-بلال قام بنشر الأحد at 17:46 الكاتب قام بنشر الأحد at 17:46 أبو خليل السلام عليكم و رحمة الله تعالى و بركاته و جزاكم الله خيرا على هذا الرد السريع . تحياتي
Eng.Qassim قام بنشر الأحد at 20:24 قام بنشر الأحد at 20:24 مشاركة مع استاذي @ابوخليل 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 1
Foksh قام بنشر الإثنين at 09:27 قام بنشر الإثنين at 09:27 (معدل) مشاركة مع الاساتذة ومعلمنا الفاضل .. 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 اضافة فكرة من خلال الاستعلام
عبد الله-بلال قام بنشر الإثنين at 18:31 الكاتب قام بنشر الإثنين at 18:31 السلام عليكم يا أساتذتي الأعزاء جزاكم الله كل الخير . عندي استفسار لأبو خليل : لقد جربت الدالة هي تعمل مع 0.5 فقط بمعنى إذا كان الرقم مثلا 8.25 تعطينا 9 و هي في الواجب تعطينا 8.50 يعني كل ما فوق 0.50 يكون صحيحا و أما دون 0.50 تعطينا بالخطأ : فمثلا : 7.75 تعطي 8 و هذا صحيح و أما 7.26 تعطينا كذلك 8 و هذا خطأ .فالواجب تعطينا 7.50 . أرجو أن أكون وفقت في إبراز الفكرة و شكرا
عبد الله-بلال قام بنشر الإثنين at 20:54 الكاتب قام بنشر الإثنين at 20:54 السلام عليكم إخواني أريد المشاركة مع أستاذي الفاضل 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
ابوخليل قام بنشر الإثنين at 22:44 قام بنشر الإثنين at 22:44 1 ساعه مضت, عبد الله-بلال said: لقد أضفت إضافة عل الدلة التي استفدنا منها جزاكم الله خيرا فأوفت بالغرض و الحمد لله الحمد لله 1
AbuuAhmed قام بنشر منذ 19 ساعات قام بنشر منذ 19 ساعات (معدل) عملت دالتين أحدهما مختصرة ولكنها فشلت في تقريب النصف، لذا استبعدتها. الدالة الأطول والأدق: 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 تم تعديل منذ 18 ساعات بواسطه AbuuAhmed 1
ابوخليل قام بنشر منذ 17 ساعات قام بنشر منذ 17 ساعات 1 ساعه مضت, AbuuAhmed said: عملت دالتين أحدهما مختصرة ولكنها فشلت في تقريب النصف، لذا استبعدتها. الدالة الأطول والأدق: يا هلا ابو احمد .. عودا حميدا من طول الغيبات جاب الغنايم
AbuuAhmed قام بنشر منذ 15 ساعات قام بنشر منذ 15 ساعات 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 جربوها. 1 1
ابو جودي قام بنشر منذ 5 ساعات قام بنشر منذ 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 جربوها. انا اللى كنت كاتب الكود ده 👆 وتجد مزيد من الشرح فى هذا الموضوع 2
ابو جودي قام بنشر منذ 4 ساعات قام بنشر منذ 4 ساعات طيب ومشاركة مع اساتذتى العظماء هذه فكرتى المتواضعة ' --------------------------------- ' 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 قام بنشر منذ 3 ساعات قام بنشر منذ 3 ساعات كنت أبحث عن موضوع سابق لي لعمل بعض الدوال شبيهة للإكسل ووجدتها بعد وقت طويل. استخدمت أحد الملفات وزدت عليه دالتك، أرجو الاطلاع. CeilingFunction4Access_04.xlsm
ابو جودي قام بنشر منذ 3 ساعات قام بنشر منذ 3 ساعات 4 دقائق مضت, AbuuAhmed said: كنت أبحث عن موضوع سابق لي لعمل بعض الدوال شبيهة للإكسل ووجدتها بعد وقت طويل. لكن دالة CEILING اساسا موجودة بالاكسل من ضمن الدوال المضمنه به ولم تكن تحتاج الى كتابة اى اكواد
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.