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

(تمت الاجابة) إدراج تاريخ بين تاريخين


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

السلام عليكم

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

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