تحديد الخلية المقابلة لتاريخ محدد

[ماجدجلال]

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

في الملف المرفق العمود A بة تواريخ ارغب في كود يقوم بتحديد الخلية المقابلة لتاريخ محدد

الملف المرفق بة مزيد من الشرح

ارجو منكم المساعدة وشكرا لكم جزيلا

10.rar

[رجب جاويش]

تفضل أخى

10.rar

[إبراهيم ابوليله]

الاخ رجب

بارك الله فيك

عمل رائع

ولكن لماذا عند ظهور InputBox

لو قمنا بعدم كتابه الى شئ ثم ضغطنا على زر OK او CXL

يحدث خطأ

[أبو حنــــين]

هذه طريقة اخرى يكفي كتابة التاريخ في الخلية H2

11111.rar

[الـعيدروس]

السلام عليكم

تفضل

Sub F_Date()

Dim SD As String

Dim CF As Range, SR As Range, LC As Range

Set SR = ورقة1.Range("A1:A100")

Set LC = SR.Cells(SR.Cells.Count)

A = InputBox("إدخل التاريخ المراد", "منتدى أوفسينا")

SD = Format(A, "Short Date")

If IsDate(SD) = False Then

MsgBox "تنسيق التاريخ غير صحيح"

Exit Sub

End If

Set CF = SR.Find(What:=CDate(SD) _

, After:=LC, LookIn:=xlFormulas, LookAt:=xlWhole, _

SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False)

If Not CF Is Nothing Then

Cells(CF.Row, ActiveCell.Column).Select

Else

MsgBox "لاتوجد نتائج لهذا البحث"

End If

End Sub

[رجب جاويش]

الاخ رجب

بارك الله فيك

عمل رائع

ولكن لماذا عند ظهور InputBox

لو قمنا بعدم كتابه الى شئ ثم ضغطنا على زر OK او CXL

يحدث خطأ

أخى ابراهيم

لتعديل الكود يتم وضع السطر التالى

On Error Resume Next

ليكون الكود كالاتى

Sub ragab()

Dim sdate As Date, cl As Range

On Error Resume Next

sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له")

For Each cl In [A6:A25]

If sdate = cl Then cl.Select: Exit For

Next

End Sub

[إبراهيم ابوليله]

الاخ رجب بارك الله فيك

ومشكورا على الرد واكوادك بجد والله رائعه وقمه فى السهوله

ولكن ماذا لو اردنا اظهار رساله تفيد بان نتيجه البحث غير موجوده فى حالة كتابه تاريخ غير موجود

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

الاخ رجب بارك الله فيك

ومشكورا على الرد واكوادك بجد والله رائعه وقمه فى السهوله

ولكن ماذا لو اردنا اظهار رساله تفيد بان نتيجه البحث غير موجوده فى حالة كتابه تاريخ غير موجود

تجد طلبك في كود اخونا ابو نصار

[إبراهيم ابوليله]

الاخ عبد الله بارك الله فيك

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

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

الاخ عبد الله بارك الله فيك

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

سيصبح الكود هكذا

Sub ragab()

on error resume next

Dim sdate As Date, cl As Range

sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له")

For Each cl In [A6:A25]

If sdate = cl Then cl.Select: Exit For Else: MsgBox "لاتوجد نتائج لهذا البحث": Exit Sub

Next

End Sub

[ماجدجلال]

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

ماشاء تبارك الله

الموضوع نشيط مرة

انا اشكر الجميع علي التفاعل الرائع الف الف شكرا وجزاك الله كل خير

[إبراهيم ابوليله]

الاخ عبد الله بارك الله فيك

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

سيصبح الكود هكذا

Sub ragab()

on error resume next

Dim sdate As Date, cl As Range

sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له")

For Each cl In [A6:A25]

If sdate = cl Then cl.Select: Exit For Else: MsgBox "لاتوجد نتائج لهذا البحث": Exit Sub

Next

End Sub

الاخ عبد الله

عملية البحث غير مفعله

عن التطبيق

فالرساله تظهر عند الضغط على زر اوك

ولاكن لا يتم الذهاب الى الخلية المطلوبه

[رجب جاويش]

أخى ابراهيم

جرب هذا التعديل

Sub ragab()

On Error Resume Next

Dim sdate As Date, cl As Range

sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له")

For Each cl In [A6:A25]

If sdate = cl Then cl.Select: MyArr = MyArr & cl & ",": Exit For

Next

x = UBound(Filter(Split(MyArr, ","), sdate)) + 1

If x = 0 Then MsgBox "لاتوجد نتائج لهذا البحث"

End Sub

[رجب جاويش]

وهذا تعديل آخر

Sub ragab()

On Error Resume Next

Dim sdate As Date, cl As Range

sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له")

For Each cl In [A6:A25]

If sdate = cl Then cl.Select: MyArr = MyArr & cl: Exit For

Next

If MyArr = "" Then MsgBox "لاتوجد نتائج لهذا البحث"

End Sub

[إبراهيم ابوليله]

الاخ رجب مشكورا

وبارك الله فيك