اذهب الي المحتوي
أوفيسنا

كود لمعرفة عدد الارقام داخل خلية


الردود الموصى بها

السلام عليكم

بناء علي طلب احد الاخوه معرفة عدد الارقام داخل خلية

و تم العمل و لاهميته تم العرض بمشاركة مستقلة

ارجو التجربة و اخباري بالنتيجة

خالص تحياتي

__________________________20____.rar

تم تعديل بواسطه aah_aah2008
رابط هذا التعليق
شارك

السلام عليكم

اخي aah_aah2008

شكرا لاهتمامك بالموضوع

المطلوب اخي بالضبط

اذا كانت الخلية فيها 10 ارقام او صفر او خليه فارغة ان تكون الخليه بدون لون

واذا كانت الخليه اكبر او اصغر من 10 ارقام داخل الخلية ان يكون لون الخليه احمر

المد المطلوب التطبيق عليه في العامود G من 8 إلى 150

ملاحظات الكود السابق

1- اهتزاز ملحوظ بالورقة

2- الكود مربوط بصفحة رقم2 وهذا مشكله عندي بسبب كثرة الاوراق داخل البرنامج الذي اعمل عليه

وانا اريد التقليل من الاوراق داخل البرنامج الذي اعمل عليه لكي يقل حجمه وعدد اوراقه .

3- هل بالامكان أن يكون الكود مربوط بالعامود G فقط والغاء العامود H والغاءربطه بالورقة2 اذا امكن

ملاحظة

اكملت الموضوع مع اخي ابو اسامه بما انها تتعلق بالتنسيق الشرطي

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

واي ملحظات ان مستعد

واكرر شكري وتقديري لك واهتمامك بالموضوع

رابط هذا التعليق
شارك

السلام عليكم

اخي جرب هذا الملف

تم التعديل للاخذ في الاعتبار 20 رقما

بالنسبة للاهتزاز قد يحدث و هذا شئ طبيعي لعمل الكود

جرب و اخبرني النتيجة

تحياتي

__________________________20____2.rar

تم تعديل بواسطه aah_aah2008
رابط هذا التعليق
شارك

السلام عليكم

الاخ ابو أسامة

شكراً لك على الكود الرائع

بس فيه مشكلة بسيطه وهيا عند حذف الصفوف يعطي خطأ بالكود

وكذلك عند مسح مجموعة خلايا بنفس العامود المعني يعطي خطأ.

الكود عدلت عليه تعديل بسيطه ليتناسب مع طلبي


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G4:G150")) Is Nothing Then Exit Sub
Select Case Len(Target)

Case Is > 10
Target.Interior.ColorIndex = 44
Target.Offset(0, 1) = Len(Target)

Case 1 To 9
Target.Interior.ColorIndex = 44
Target.Offset(0, 1) = Len(Target)

Case 10
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = Len(Target)

Case 0
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = ""
End Select
End Sub

تحياتي لك

رابط هذا التعليق
شارك

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo omar
If Intersect(Target, Range("a1:a100")) Is Nothing Then Exit Sub
Select Case Len(Target)
Case Is > 10
Target.Interior.ColorIndex = 44
Target.Offset(0, 1) = Len(Target)
Case 1 To 9
Target.Interior.ColorIndex = 4
Target.Offset(0, 1) = Len(Target)
Case 10
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = Len(Target)
Case 0
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = ""
End Select
omar:
End Sub

هنا لا يظهر خطا

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information