تعبئة الخلايا بكلمة TRUE بناءً على التواريخ والمدة المحددة لكل الأسماء

[محمود ع المنعم]

برجاء من السادة الافاضل المساعدة في الفايل المرفق استكمال التاريخ بناءا ع الاسم مع العلم بان عندي حوالي 500 اسم في الملف

في حالة عدم الحضور فترة من والى يكتب True لكل التواريخ تحت اسم معين في الشيت.

data.rar

[ياسر خليل أبو البراء]

الأخ الكريم d911

يرجى تغيير اسم الظهور للغة العربية كما يرجى الإطلاع على رابط التوجيهات لمعرفة كيفية التعامل مع المنتدى

من هنا التوجيهات (ضروري وهام)

إليك الكود التالي عله يفي بالغرض

Sub FillTRUE()
    Dim Source As Worksheet, Target As Worksheet, Cell As Range
    Dim FoundColumn, FoundRow
    Set Source = Sheet1: Set Target = Sheet2
    
    With Application
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    
        For Each Cell In Source.Range("B2:B" & Source.Cells(Rows.Count, "B").End(xlUp).Row)
            FoundRow = Application.Match(Cell.Offset(, -1), Target.Columns(1), 0)
            FoundColumn = Application.Match(Cell, Target.Rows(1), 0)
    
            If IsNumeric(FoundColumn) And IsNumeric(FoundRow) Then
                Target.Cells(FoundRow, FoundColumn).Resize(, Cell.Offset(, 2).Value) = "TRUE"
            End If
        Next Cell
        
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic
    End With
End Sub

تقبل تحياتي

[محمود ع المنعم]

استاذ ياسر مشكور ع سرعة الرد 

بس استاذنك لو في امكانيه للحل بالمعادﻻت

[ياسر خليل أبو البراء]

أعتقد أن كثرة المعادلات بالملف مع هذا العدد من الأعمدة سيتسبب في ثقل الملف ..

عموماً ننتظر الأخوة المتخصصين في المعادلات لمعالجة الأمر

 

[محمود ع المنعم]

استاذ ياسر طب ممكن حضرتك تشرحلي الكود عشان عاوز اطبقه على شيت عندي غير المرفق بشكل تاني

[ياسر خليل أبو البراء]

إن شاء الله ليلاً إن تيسر لي الوقت سأقدم لك شرحاً للكود ...

تقبل تحياتي ويرجى مراجعة التوجيهات (خاصةً اسم الظهور)

أخي الكريم

جرب المعادلة التالية في الخلية B2 في ورقة العمل data

=IF(SUMPRODUCT(('Sheet 1'!$A$2:$A$500=$A2)*(B$1>='Sheet 1'!$B$2:$B$500)*(B$1<='Sheet 1'!$C$2:$C$500))>0,TRUE,"")

ثم قم بسحب المعادلة لأسفل وإلى اليمين إلى آخر النطاق للأعمدة والصفوف

إذا لم تعمل المعادلة يمكنك استبدال الفاصلة في المعادلة بفاصلة منقوطة

 

كما يمكنك استخدام المعادلة التالية

=IF(COUNTIFS('Sheet 1'!$A$2:$A$500,$A2,'Sheet 1'!$B$2:$B$500,"<="&B$1,'Sheet 1'!$C$2:$C$500,">="&B$1)>0,TRUE,"")

 

تم تعديل سبتمبر 14, 2015 بواسطه ياسر خليل أبو البراء

[محمود ع المنعم]

تم تعديل الاسم:)

[ياسر خليل أبو البراء]

والله قصرت أخي محمود لما استخدمت حرف العين بدلاً من كلمة عبد

كان هيبقا شكلها أحلى لو كان اسم الظهور : محمود عبد المنعم

عموماً أحسن من الاسم الأولاني d1425hd

[محمود ع المنعم]

أ ياسر ربنا يباركلك الكود تمام بس فعلا الملف تقيل جدا فعلا والكود اخف بكتير بس محتاج افهمه عشان اعدله طبقاً لملفي الشخصي لما وقت حضرتك يسمح تشرحهولي

بس لو ممكن يبقى في كود يطلعلي لو في عدد 6 true متلاحقة بدون فاصل بنفس الملف

انا اسف ع الاطاله

تم تعديل سبتمبر 14, 2015 بواسطه محمود ع المنعم

[ياسر خليل أبو البراء]

أخي الكريم محمود

إن شاء الله سأقوم بشرحه حين يتيسر لي الوقت أما الآن فأنا منشغل قليلاً ..

الجزء الثاني من الطلب غير مفهوم بالنسبة لي .. يا حبذا لو أرفقت شكل النتائج المتوقعة ..

ماذا تريد من الكود أن يفعل في حالة أن هناك عدد 6 True في صف واحد متلاحقة (هل تقصد متتالية لا يوجد بينها خلايا فارغة؟) .. وفي هذه الحالة المطلوب من الكود ايه بالظبط؟

[محمود ع المنعم]

يعني لما اﻻقي 6 true يكتب yمثﻻ بس شرط تكون متﻻحقه بدون فواصل 

[ياسر خليل أبو البراء]

جرب الملف التالي وأعلمنا بالملاحظات (ويرجى دائماً مزيد من التوضيح ...)

Put TURE Or Y.rar

[محمود ع المنعم]

تم ارفاق الملف للايضاح

[محمود ع المنعم]

تم ارفاق الملف للايضاح

 اللي ف الصورة دا اللي عاوز اوصله ان لو اي اسم اخد 6 ايام غياب متصله يكتب حرف ال y هل في ممكن معادله توصلنا للنتيجة دي

[ياسر خليل أبو البراء]

جرب التعديل في الكود بهذا الشكل

Sub FillTRUE()
    Dim Source As Worksheet, Target As Worksheet, Cell As Range, Area As Range
    Dim FoundColumn, FoundRow
    Set Source = Sheet1: Set Target = Sheet2
    
    With Application
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    
        For Each Cell In Source.Range("B2:B" & Source.Cells(Rows.Count, "B").End(xlUp).Row)
            FoundRow = Application.Match(Cell.Offset(, -1), Target.Columns(1), 0)
            FoundColumn = Application.Match(Cell, Target.Rows(1), 0)
    
            If IsNumeric(FoundColumn) And IsNumeric(FoundRow) Then
                Target.Cells(FoundRow, FoundColumn).Resize(, Cell.Offset(, 2).Value) = "TRUE"
                If Cell.Offset(, 2).Value >= 6 Then Target.Cells(FoundRow, 2) = "Y"
            End If
        Next Cell
        
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic
    End With
End Sub

 

Put TURE Or Y V2.rar