ايجاد رقم في جدول وتغيير لونه

[ابو تيم]

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

 

عندي جدول بتنسيق text وتحتوي كل خلية على ثلاثة ارقام وجدول آخر تحوي كل خلية على رقم واحد 

أريد أن يقرأ اكسل الرقم في  كل خلية على حدة ويغير لون الارقام حسب الرقم بحيث يكون لكل رقم لون معين(عشرة ألوان من 0 - 9

فلو كان الرقم بالخلية هو 397 يقرأ اكسل مئات الرقم ويلونه حسب قيمته ثم يقرأ العشرات ويغير لونه ثم آحاد الرقم الرقم 9 مثلا يصبح في كل الجدول أحمر

ثم ينتقل الى خلية أخرى حتى نهاية الجدول

ومشكوين سلفا 

تم تعديل مايو 22, 2014 بواسطه MAICL

[رجب جاويش]

أخى الفاضل

أولا : مرحبا بين إخوانك عضوا جديدا فى منتدى أوفيسنا العريق

ثانيا : لك منى دعوة طيبة بتغيير اسم الظهور إلى اللغة العربية ليسهل التواصل بيننا ( طبقا لسياسة المنتدى )

ثالثا : يفضل إرفاق ملف للعمل عليه توفيرا للوقت والجهد

 

 

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف

[ابو تيم]

شكرا أخي رجب  

 

وهذا هو الملف بالمرفقات

Book1.rar

[جمال عبد السميع]

تفضل أخى ماطلبت

لو أنى لاأريد الأنخراط فى عمل الكود

معلش لأنى ليس لدى أوفيس 2007 البرنامج اللى عندى لايريد عمل " save " للماكرو

لذلك تفضل الكود وأضغط على "alt+f11 " ثم "insert "ثم " module " ثم ضع هذا الكود

Sub gamal()
Dim Rng         As Range
Dim Dn          As Range
Dim q           As String
Dim cols        As Variant
Dim n           As Long
'تغيير الألوان لتناسب
cols = Array(0, 1, 3, 4, 5, 6, 7, 38, 46, 50)
Set Rng = Range(Range("A1:c4"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
 Dn = Replace(Dn, " ", "")
 q = StrConv(Dn, vbUnicode)
     Dn = Join(Split(Left(q, Len(q) - 1), vbNullChar), " ")
        For n = 1 To Len(Dn)
           With Dn.Characters(n, 1)
                .Font.ColorIndex = cols(Val(Dn.Characters(n, 1).Text))
                .Font.Bold = True
            End With
        Next n
Next Dn
End Sub

تقبل تحياتى

تغيير لون الرقم.rar

[ا بو سليمان]

تفضل أخى ماطلبت

لو أنى لاأريد الأنخراط فى عمل الكود

معلش لأنى ليس لدى أوفيس 2007 البرنامج اللى عندى لايريد عمل " save " للماكرو

لذلك تفضل الكود وأضغط على "alt+f11 " ثم "insert "ثم " module " ثم ضع هذا الكود

Sub gamal()
Dim Rng         As Range
Dim Dn          As Range
Dim q           As String
Dim cols        As Variant
Dim n           As Long
'تغيير الألوان لتناسب
cols = Array(0, 1, 3, 4, 5, 6, 7, 38, 46, 50)
Set Rng = Range(Range("A1:c4"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
 Dn = Replace(Dn, " ", "")
 q = StrConv(Dn, vbUnicode)
     Dn = Join(Split(Left(q, Len(q) - 1), vbNullChar), " ")
        For n = 1 To Len(Dn)
           With Dn.Characters(n, 1)
                .Font.ColorIndex = cols(Val(Dn.Characters(n, 1).Text))
                .Font.Bold = True
            End With
        Next n
Next Dn
End Sub

تقبل تحياتى

مبدع اخي  جمال ....................

[ابو تيم]

الف شكر أخواني جمال وزمزم وجعله الله في ميزان حسناتكم   والله لساني عاجز عن شكركم

 

 

فألف شكر