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

تغير لون خلية بتغيير خليه اخرى


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

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

 

الاخوة الافاضل اسرة منتديات اوفيسنا

 

اريد كود يقوم بتغير لون اقرب خلية من خليه اخرى

 

ارجو الاطلاع على المرفق لتتضح الصورة اكثر

 

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

Worksheet.rar

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

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

بارك الله فيك استاذي الحبيب استاذ /رجب جاويش

وشكراً على العمل

ولي طلب لاثراء الموضوع

ممكن نعرف المعادلة المستخدمة في التنسيق الشرطي

بارك الله فيك

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

أخى الحبيب / محمد

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

هذه هى المعادلة المستخدمة فى التنسيق الشرطى

=B5=SUMPRODUCT(--(SMALL(ABS(History-$B$2);1)=ABS(History-$B$2));(History))
  • Like 2
رابط هذا التعليق
شارك

استاذ رجب معذرة مرة أخرى على تعبك معي ولكن جربت شئ

وظهرت بعض العيوب

فهذه المعادلة لا تظهر النتائج اذا كان الرقم مكرر  في الجدول فهل من حل لهذه المشكلة...

موضح بالصورة ما اقول

dOmah.png

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

أخى الحبيب / محمد

فى حالة التكرار جرب المعادلة الآتية فى التنسيق الشرطى

=B5=SUMPRODUCT(--(SMALL(ABS(History-$B$2);1)=ABS(History-$B$2));(History/SUMPRODUCT(--(SMALL(ABS(History-$B$2);1)=ABS(History-$B$2)))))

Worksheet 2.rar

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

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

 

الاستاذ الفاضل 

رجب جاويش

زاد الله لك في علمك و بارك لك فيه

اشكرك اخي الكريم هذا على مجهودك و عملك الرائع جعله الله في ميزان اعمالك

 

 

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

لان العمل اللي عندي يكون اسهل لو كان كود

 

اشكرك مرة اخرى

 

ياليت ان امكن عمل تحديد للخلية الاقرب

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

 

عملت كود لكن ما ضبط

Worksheet.rar

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

السلام عليكم

 

هذا كود فكرته من معادلة اخي الحبيب رجب جاويش

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("B2").Address Then Exit Sub

Dim cel As Range, rng As Range
Dim t As Double, tt As Double, ttt As Double
t = Val(Target)

With Range("B5:M21")
    .Interior.ColorIndex = 6
    For Each cel In .Cells
        tt = Abs(Val(cel) - t)
        If rng Is Nothing Then
            Set rng = cel: ttt = tt
        Else
            If tt = ttt Then Set rng = Union(rng, cel)
            If tt < ttt Then Set rng = cel: ttt = tt
        End If
    Next
End With
rng.Interior.ColorIndex = 10
Set rng = Nothing
End Sub

المرفق 2003

تحياتي

تغيير لون الخلية.rar

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

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

 

الاستاذ الفاضل 

عبدالله باقشير

 

جزاك الله خير الجزاء عمل رائع وممتاز اشكرك اخي الكريم

 

والشكر و الدعاء موصول للاستاذ الفاضل 

 
جزاكم الله خير الجزاء
هذا هو المطلوب تماما
رابط هذا التعليق
شارك

أستاذى الحبيب / عبد الله باقشير

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

وكود رائع من أستاذ الأجيال

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

السلام عليكم

 

هذا كود فكرته من معادلة اخي الحبيب رجب جاويش

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("B2").Address Then Exit Sub

Dim cel As Range, rng As Range
Dim t As Double, tt As Double, ttt As Double
t = Val(Target)

With Range("B5:M21")
    .Interior.ColorIndex = 6
    For Each cel In .Cells
        tt = Abs(Val(cel) - t)
        If rng Is Nothing Then
            Set rng = cel: ttt = tt
        Else
            If tt = ttt Then Set rng = Union(rng, cel)
            If tt < ttt Then Set rng = cel: ttt = tt
        End If
    Next
End With
rng.Interior.ColorIndex = 10
Set rng = Nothing
End Sub

المرفق 2003

تحياتي

NirHy.gif

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

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

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



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

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

Important Information