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

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

قام بنشر

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

إحدى الحلول البسيطة بواسطة التّنسيق الشّرطي و تلوين خلية التّاريخ محل البحث ..ربما تفي بالعرض

فائق إحتراماتي

 

كود انتقال.rar

  • Like 1
قام بنشر

أختي الفاضلة جربي الكود التالي

Sub Find_Date()
    Dim C As Range, StrDate As Date, Rng As Range
    StrDate = CLng(Range("B3"))
    Set Rng = Union(Columns("E:E"), Range("E3:O3"))
    
    Set C = Rng.Find(What:=StrDate, LookIn:=xlFormulas)
    If Not C Is Nothing Then C.Select
End Sub

 

 

قام بنشر

السلام عليكم

او بالكود التالي لاثراء الموضوع

Sub Ali_Rng_Find()
Dim Rng As Range, Rn As Range, R As Range
Set Rn = [B3] '' خلية شرط البحث
For Each Rng In ActiveSheet.UsedRange
 If Rng.Value = Rn.Value And IsDate(Rn) And _
   Rng.Address <> Rn.Address Then
   If Not Rng Is Nothing Then If R Is Nothing Then _
   Set R = Rng Else Set R = Union(R, Rng)
 End If
Next Rng
If Not R Is Nothing Then R.Interior.ColorIndex = 3: R.Activate
Set Rng = Nothing: Set Rn = Nothing: Set R = Nothing
End Sub

 

  • Like 2
قام بنشر
Sub Ali_Rng_Find2()
Dim Rng As Range, Rn As Range, R As Range
Set Rn = [B3] '' خلية شرط البحث

Sheets("ورقة1").Range("E3").CurrentRegion.Interior.Pattern = xlNone
For Each Rng In ActiveSheet.UsedRange

 If Rng.Value = Rn.Value And IsDate(Rn) And Rng.Address <> Rn.Address Then
   
   If Not Rng Is Nothing Then If R Is Nothing Then Set R = Rng Else Set R = Union(R, Rng)
   
 End If
Next Rng
If Not R Is Nothing Then R.Interior.ColorIndex = 3: R.Activate
Set Rng = Nothing: Set Rn = Nothing: Set R = Nothing
End Sub

حل رائع أخى الكريم  العيدروس

لو تسمح بالاضافة  السابقة ( ازالة اللون عن الخلايا المحددة باللون الأحمر سابقا  و تلوين الخلايا المحددة حاليا فقط )

 

  • Like 1

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

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

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

Important Information