تغيير دقة الأرقام فى بعض الخلايا

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

لتغيير دقة الارقام الموجودة فى خلايا و اظظهار الناتج فى خلايا أخري

يمكننا استخدام دوال عديدة كما ورد فى عدة أمثلة فى المنتدي

سواء جاهزة مثل round,roundup

او دوال اضافية

و هنا يظهر الناتج فى خلايا جديدة

أو نقوم باختيار أن تكون الدقة مناظرة للتنسيق الظاهر ، من Tools, options, Calcualations

precision as displayed

أما المثال المرفق

فنقوم فيه باختيار الخلايا المطلوب تغيير دقتها

و نشغل أحد الكودين

الاول للتقريب العادي و الثاني للتقريب للاعلي ، و تظهر رسالة تسأل عن درجة دقة التقريب المطلوبة

و الثالث للتحويل الي القيمة الصحيحة فقط

ووجدتني أحتاج ذلك فى بعض الملفات ، و أرجو أن يكون مفيدا :(

ملاحظة : لا تطبقه علي خلايا بها معادلات لانه سيقوم بتحويلها الي القيم المناظرة و يلغي المعادلات

و انما علي الارقام المباشرة فقط

Sub rounditapprox()
 Dim rr, cc, ap As Integer
 ap = InputBox("Enter the Number Of digits for Approximation", "www.officena.net", 0)
 rr = Selection.Rows.Count
 cc = Selection.Columns.Count
 For i = 0 To rr - 1
 For j = 0 To cc - 1
   ActiveCell.Offset(i, j) = Round(ActiveCell.Offset(i, j), ap)
 Next j
 Next i
End Sub


Sub rounditapproxUP()
 Dim rr, cc, ap As Integer
 ap = InputBox("Enter the Number Of digits for Approximation", "www.officena.net", 0)
 rr = Selection.Rows.Count
 cc = Selection.Columns.Count
 For i = 0 To rr - 1
 For j = 0 To cc - 1
   ActiveCell.Offset(i, j) = Application.WorksheetFunction.RoundUp(ActiveCell.Offset(i, j), ap)
 Next j
 Next i
End Sub

Sub takeinteger()
 Dim rr, cc  As Integer
 rr = Selection.Rows.Count
 cc = Selection.Columns.Count

 For i = 0 To rr - 1
 For j = 0 To cc - 1
   Dim mycell As Double
   mycell = ActiveCell.Offset(i, j).Value * 100
    ActiveCell.Offset(i, j).Value = ((Round(mycell, 0) - Round((mycell Mod 100), 0)) / 100)
    ActiveCell.Offset(i, j).NumberFormat = "#,##0"
 Next j
 Next i
End Sub

RoundSelection.rar

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

ملاحظة : تم تعديل الملف بعد تنزيله 4 مرات يرجي اعادة التنزيل ممن أنزلوه

مع تحياتي