تعديل كود لعمل بوردر اذا اختلف الرقم قى مجال معين

[saad abed]

السلام عليكم

حاولت عمل عمل حد اذا اختلف رقم القبد بالزيادة 

دون جدوى

استخدمت اف وغيرت نوت اف

ولم افلح

ارجو المساعدة

Sub hh()
With Sheets("íæãíÉ")
For R = 4 To 5000
If .Cells(R, 2).Value < .Cells(R, 2).Value Then
Last1 = .Cells(Rows.COUNT, "b").End(xlUp).Row
.Range("b" & Last1 & ":m" & Last1).Borders.Value = 1
.Range("b" & Last1 & ":m" & Last1).Borders(xlEdgeTop).LineStyle = xlNone
.Range("b" & Last1 & ":m" & Last1).Borders(xlEdgeBottom).Weight = xlThick
.Range("b" & Last1 & ":m" & Last1).Borders(xlEdgeBottom).ColorIndex = 3
End If
Next
End With
End Sub

acc.rar

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

[عبدالله المجرب]

اخي سعد 

هذا السطر به الخلل

If .Cells(R, 2).Value < .Cells(R, 2).Value Then 

انت اشترطت ان اذا قيمت الخلية ولنفرض (B6) أكبر من قيمة نفس الخلية 

ولذلك لم يتحقق الشرط لان الخلية تساوي نفسها ولا يمكن ان تكون اكبر 

 

كما ان التنسيق الذي سيتطبق سيتطبق على الخلية الاخيرة فقط 

هل ممكن ان تشرح ما تريد لنعدل لك الشرط

[saad abed]

اخى عبدالله ابواحمد

اولا اشكرك على ردكم السريع

المطلوب فى المجال b4:b5000

القيود لها ارقام اريد فاصل بوردر كلما تغير الرقم فى هذا المجال

اشكرك

[سليم حاصبيا]

اخي سعد

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

acc.rar

[سليم حاصبيا]

بعد اذن الاستاذ عبدالله المجرب

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

acc 1.rar

[saad abed]

اخى سليم

اشكرك كل الشكر على اهتمامك

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

بارك الله فيك

ما اخرنى فى الرد لانى تواصلت مع اخى وصديقى شوقى ربيع وقدم لى الكود التالى

Sub ffff()
Application.ScreenUpdating = False
With sheet5
Last1 = .Cells(Rows.COUNT, "b").End(xlUp).Row
For R = 4 To Last1
If .Range("B" & R) < .Range("B" & R + 1) Then
With .Range("b" & R & ":m" & R).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    End With
Else
    With .Range("b" & R & ":m" & R).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub