اذهب الي المحتوي
أوفيسنا

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

قام بنشر

السلام عليكم

تفضل أخي الكود التالي في حدث الصفحة

Private Sub Worksheet_Change(ByVal Target As Range)

x = Target.Value

If Target.Column <> 10 Or IsDate(x) = False Then Exit Sub

    Sdate = [A2]			    'start date

    Ldate = [A10000].End(xlUp)  'last date

If x < Sdate Or x > Ldate Then MsgBox ("Out of Range!  Date is out of range"): Exit Sub


For r = 2 To [A10000].End(xlUp).Row - 3

    y1 = Cells(r, "A"): y2 = Cells(r + 3, "A")

    If y1 < x And y2 > x Then

	    o = 1

	    If (x - y1) / (y2 - y1) > 0.5 Then o = 2

	    With Cells(r + o, "A")

		    .Value = x

		    .Interior.ColorIndex = 3

		    .Font.Bold = True

	    End With

	    Exit Sub

    End If

Next r


End Sub

قام بنشر

السلام عليكم

مرفق الملف وقد تم تغيير مواضع الأعمدة كما تريد

العمود A أصبح E و العمود J أصبح I

وتم حذف الأسطر التي ليس بها بيانات بغرض تقليل حجم الملف

(عندي مشكلة في رفع الملفات)

تفضل المرفق بالرابط

http://www.4shared.com/rar/RKA0GhlN/2__online.html

قام بنشر

رائع

وبارك الله فيك ياطارق باشا وجزاك الله خيراً

ولكن لو تكرمتم لى طلب اخر

كود لإخفاء أى صف ليس مدون به تاريخ ولايؤثر على المعادلات

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

تم اضافة حل في طلبك بهذا الخصوص

كل الشكر على التحف التي جاد بها الاستاذ طارق

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information