اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر (معدل)

السلام عليكم

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

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

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

خالص تحياتي

__________________________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

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information