اريد عمل اكواد معينة بالفيجوال على عدة اعمدة في صفحات مختلفة

[عبد الله السعيد]

اريد كود وليس معادلة تفرض في اي عمود اريده في الملف وفي اي ورقة الأتي :

فرض العلامة العشرية ان تكون 2 مهما تم التعديل في تنسيق الخلايا اي انه لابد ان يظهر الرقم 15.00 مثلا مهما تم التعديل في تنسيق الخلايا

والطلب الأخر كذلك بالأكواد وهو التقريب في نفس العمود هذا لأقرب 0.05 ، بمعنى عندما اكتب ولو بالغلط 15.42 تتحول لأقرب 0.05 بأن تكون مباشرة 15.45 ،،مثال اخر 15.28 تتحول مباشرة 15.30 وهكذا

اريد ماسبق بالأكواد المحفوظة على عدة اعمدة في ملف ما

[عبد الله السعيد]

هل من حلول اخواني  ؟

[عبد الله السعيد]

هل من حلول اخواني  ؟

هل من حلول اخواني  ؟

[سليم حاصبيا]

جرب هذا الملف العامود الاصفر هو المعني بالامر

 

format_as_you_like.rar

[عبد الله السعيد]

بارك الله فيك استاذنا هذا المطلوب

 

عند تطبيق الكود على الملف الموجود لدي رفض تطبيق المعادلة واعطاني هذه الأخطاء  ، حيث لدي كود اخر للروزنامة
 

 

 

تم تعديل ديسمبر 28, 2016 بواسطه عبد الله السعيد

[عبد الله السعيد]

في انتظار الرد

[عبد الله السعيد]

هل من متابعة

[عبد الله السعيد]

 

هل من متابعة

[عبد الله السعيد]

UP

[أبو عبد النور]

السلام عليكم،

جرب هذا الكود.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub
    Target.NumberFormat = "0.00"
    x = Target.Value
    y = Application.WorksheetFunction.Ceiling(x, 0.05)
    Target = y
End Sub

 

[عبد الله السعيد]

اخي هو نفس الكود اعلاه

 

اقصد عند اضافته في الملف في ظل وجود اخرى  تظهر الرسائل اعلاه

[أبو عبد النور]

السلام عليكم،

هناك سطر اضافي في الكود.

On Error Resume Next

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub
    Target.NumberFormat = "0.00"
    x = Target.Value
    y = Application.WorksheetFunction.Ceiling(x, 0.05)
    Target = y
End Sub

 

[عبد الله السعيد]

جزاك الله خيرا  ، ولكن لدي مشكلة برجاء الحل

ولكن تقابلني مشكلة وهي عند كتابة اي رقم في العمود ومسحه لا يمسح يظل  0.00

بل لاحظت ايضا عن الوقوف على اي خلية في العمود ولو فارغة والضغط على delete من لوحة المفاتيح تتحول الى  0.00

تم تعديل يناير 5, 2017 بواسطه عبد الله السعيد

[أبو عبد النور]

لان تنسيق العمود عبارة عن 0.00

[أبو عبد النور]

جرب الكود التالي :

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub
    If Target.Value <> "" Then
        Target.NumberFormat = "0.00"
        x = Target.Value
        y = Application.WorksheetFunction.Ceiling(x, 0.05)
        Target = y
    Else
        Target.NumberFormat = "@"
    End If
End Sub

 

تم تعديل يناير 5, 2017 بواسطه أبو عبد النور

[أبو عبد النور]

عدل السطر :

        Target.NumberFormat = "@"

الى الآتي :

        Target.NumberFormat = "General"

 

[عبد الله السعيد]

جزاك الله خيرا

الكودين يعملان بصورة جيدا مالفرق بينهما ؟؟

وهل ممكن اضافة للكود ليعمل عمود ما اخر يكون باللغة العربية فقط

[عبد الله السعيد]

السلام عليكم  اخي ابو عبد النور   عند تطبيق الكود اعلاه على ملف خالي يعمل جيدا

ولكن عند تطبيقه على ملف لدي عليه اكواد اخرى يعمل ريستارت للإكسل كلما ادخلت اي رقم في العمود 3  ولا اعرف السبب ماذا  ، وجربت الكودين  علما إني لا اضع اي اكواد الا المرفوعه صورها اعلاه  ، مثل التاريخ

 

 

[أبو عبد النور]

لا ادري ما اصل المشكلة.

حاول تجريب هذا الكود المعدل :

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Target.Value <> "" Then
        Target.NumberFormat = "0.00"
        x = Target.Value
        y = Application.WorksheetFunction.Ceiling(x, 0.05)
        Target = y
    Else
        Target.NumberFormat = "General"
    End If
    Application.EnableEvents = True
End Sub

 

[عبد الله السعيد]

السلام عليكم  اخي ابو عبد النور    الكود الأخير اكثر من رائع ولكن به مشكلة وجدتها صدفة وهي انه يلغى تماما اي عملية للتراجع  يعني اريد عمل تراجع لأي شيء قمت به سواء من اشرطة الأدوات او اختيار امر  كنترول مع Z لا يعمل

 

 

 

[سليم حاصبيا]

من طبيعة الاكسل لا يمكن التراجع عن اي عمل تم تنفيذه عن طريق الكود

[عبد الله السعيد]

بارك الله فيك على الرد والإهتمام

طيب هل لها من حل اخي الفاضل


 

 

 

تم تعديل يناير 28, 2017 بواسطه عبد الله السعيد