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

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

قام بنشر

السلام عليكم

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

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

قام بنشر

رائع

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

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

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

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

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information