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

[الســـــــاهر]

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

 

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

 

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

 

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

 

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

Worksheet.rar

[رجب جاويش]

السلام عليكم

تفضل أخى ما تريد

 

Worksheet.rar

[محمد ابو البـراء]

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

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

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

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

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

بارك الله فيك

[رجب جاويش]

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

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

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

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

[محمد ابو البـراء]

بارك الله فيك استاذي الغالي

ولكن اظن ان المعادلة بها شئ

فهي لا تعمل بطريقة صحيحة...

فما السبب استاذي الحبيب

[قنديل الصياد]

[محمد ابو البـراء]

بارك الله فيك أخي الكريم/ استاذ رجب

تم الوصول للمعادلة من قواعد التنسيق الشرطي

بعتذر على  تعبك معي...

[محمد ابو البـراء]

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

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

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

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

تم تعديل يناير 15, 2014 بواسطه محمد ابو البـراء

[رجب جاويش]

أخى الحبيب / قنديل الصياد

شكرا جزيلا على مرورك العطر

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

[رجب جاويش]

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

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

=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

تحياتي

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

السلام عليكم

لاثرء الموضوع

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

=ABS(B5-$B$2)=MIN(ABS(History-$B$2))

المرفق 2003

تغيير لون الخلية تنسيق شرطي.rar

[محمد ابو البـراء]

شكرا لاستاذنا الكبير

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