مشكلة بسيطة لكن مش عارف أحلها

[يوسف عطا]

عاوز العلامة العشرية تكون بعد رقم واحد فقط فى جميع الخلايا ما عدا الرقم الصحيح عاوزه بدون علامة عشرية

جربت من قايمة تنسيق خلايا ولكنها لا تحقق طلبى فهى إما تضع علامة عشرية على كل الخلايا أم تزيلها وتقرب الأرقام للرقم الصحيح فى كل الخلايا

أتعشم يكون طلبى مفهوم

كود يضع العلامة العشرية بعد رقم واحد فى حالة وجود كسر عشرى وفى نفس الوقت لا يضع علامة عشرية على الرقم الصحيح

الكود عايزه تلقائى بمجرد فتح المصنف ويعمل فى كل الشيتات

الف شكر

[بن علية حاجي]

السلام عليكم ورحمة الله

أخي الكريم يوسف أعتقد أن الخلل الذي حدث بالموقع مؤخرا قد حذف كل الردود على الموضوع التي قدمناها وقدمها إخوتي الكرام... وسأعيد عليك الكود (الأخير) الذي قدمته في أحد ردودي مع أمل تحسينه من أحد الإخوة الكرام أو إعطاء طريقة أخرى مثل التي قدمها أخي وحبيبي هشام والتي تفي بمطلوبك... والكود هو كالتالي:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If VarType(Target) = 8 Then

        Target = Target

    Else

        If Target - Int(Target) = 0 Then

            Target = Target

        Else

            Target = Round(Target, 1)

        End If

    End If

End Sub

أخوك بن علية

[سالم شباني]

السلام عليكم

إليك أخي هذه المحاولة البسيطة لعلها تفي بالغرض

علامة عشرية.rar

[بن علية حاجي]

السلام عليكم ورحمة الله

السلام عليكم

إليك أخي هذه المحاولة البسيطة لعلها تفي بالغرض

أخي وحبيبي سالم، هذه الطريقة لا تفي بالمطلوب ثم إن نتيجة الدالتين LEFT و RIGHT هي نتيجة نصية وليست رقمية... بالإضافة إلى ذلك إن كانت الأعداد تحوي أكثر من 4 أرقام قبل الفاصلة فإن نتائج الصيغة تكون خاطئة مثلا إذا وضعت العدد 12345.76 تجعلها 1234...

والله أعلم

[عادل حنفي]

السلام عليكم

الشكر موصول للجميع علي المجهود المبذول

اخي يوسف

ارفق لك ملف اعجبتني فكرة اخي hben

فاحببت ان انفذها و لكن بطريقة اشمل

جرب المرفق و اخبرني النتيجة

تحياتي

العلامة العشرية1111.rar

[سالم شباني]

السلام عليكم

أخي بن علية ، جمعة مباركة

معذرة لم أشاهد ردك وما قدمته أنا مجرد محاولة أشكرك على الملاحظة

[يوسف عطا]

جازاكم الله جميعاً خيراً

جارى تجربة جميع الحلول المذكورة

والشكر موصول اخوتى الاعزاء

[بن علية حاجي]

السلام عليكم ورحمة الله

السلام عليكم

الشكر موصول للجميع علي المجهود المبذول

اخي يوسف

ارفق لك ملف اعجبتني فكرة اخي hben

فاحببت ان انفذها و لكن بطريقة اشمل

جرب المرفق و اخبرني النتيجة

تحياتي

أخي الكريم أعجبني كثيرا ما قمت به، والله رائع جدا هذا التدخل وهذه اللمسة، وهذا ما كنت شخصيا أنتظره من إخوتي الكرام وهذا أيضا هو الطلب المنشود من الأخ يوسف، بارك الله فيك أخي الكريم وجزاك الله خير الجزاء وزادك الله علما وفيرا... ويبقى المشكل الوحيد هو في المعادلات والصيغ المكتوبة في الملفات، فالأكواد التي قدمناها تقوم بمسحها وتعويضها بنتيجتها التي تم تطبيق التنسيق الخاص عليها... وقد قمت بإضافة الأسطر التالية في الكود:

If Target.HasFormula Then

Target = Target.Formula

Else

مع End If في نهاية الكود والكود خاصتك يكتب بالشكل التالي (حسب الإضافة الجديدة):

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

For Each Cell In ActiveSheet.UsedRange

On Error Resume Next

If Cell.Value <> 0 Then

    If Cell.HasFormula Then

        Cell = Cell.Formula

    Else

        If Cell.Value - Int(Cell) = 0 Then

            Cell.Value = Round(Cell, 0)

        Else

            Cell.Value = Round(Cell, 1)

        End If

    End If

End If

Next

End Sub

وهذه الأوامر تُبقي على المعادلات والصيغ كما هي (وحتى التنسيق الخاص لا يطبق عليها)... ولم أجد حلا لهذه المشكلة إلا تغيير كل معادلة مكتوبة في الورقة بالشكل التالي:

=IF(X-INT(X)=0;X;ROUND(X,1))

حيث X يمثل عبارة المعادلة (الأصلية) كلها

وأنتظر لمسات الإخوة الكرام في تغيير هذه الأوامر إلى أوامر تلقائية دون المساس بالمعادلات والصيغ...

أخوكم بن علية

والله أعلم

تم تعديل يوليو 2, 2010 بواسطه hben

[يوسف عطا]

السلام عليكم أخوتى الأعزاء

الأخ العزيز بن علية الف شكر على تعبك

عندى سؤال

هل يمكن إضافة جملة على الكود المذكور تجعل باقى الأكواد والمعادلات لا تتأثر بالكود ؟؟

مجرد فكرة خطرت لى ولكن لا أستطيع تحويلها إلى واقع

فيلدلى كل بدلوه ربما نحصل على حل اسهل

لأن فكرة تعديل كل الأكواد والمعادلات بالملف ستكون صعبة إلى حد ما