المنطق غير واضح ..
لماذا يوجد 2 انصراف متتاليين ولم تقم بالإشارة إلى أن أحدهما خطأ ...؟

نعم أخي الكريم .. ولكن السؤال ما هو المنطق في تصحيح الأخطاء الناتجة عن جهاز البصمة؟ لابد من وجود منطق واضح ليستطيع الأخوة تقديم المساعدة المطلوبة
وعموماً اطلع على الملف التالي (مشابه لمشكلتك على ما أعتقد) عله يفيدك في حل المشكلة

الكود جميل جدا بس أستاذى صعب تنفيذه عندى فى الملف فبه أكثر من 200 موظف -وكل موظف له صفحة مستقلة كما رايت فى ملفى والصفحة المسحوبة من جهاز البصمة فى صفحة أخرى
والمغزى من تصحيح اخطاء ملف جهاز البصمة هو ترحيل البيانات الى صفحات الموظفين بكل دقة وأمانة حتى يتم محاسبتهم على وقتهم فى العمل حتى لا يكون هناك ظلم لأحد -فالمرتب مقابل عدد ساعات بقائهم فى المكتب وساعات العمل التى طبقا لقانون العمل هى 8 ساعات
ولكم جزيل الشكر وبارك الله فيكم على ردكم واستجابتكم الكريمة

أسف أستاذى الكريم ياسر وأعتذر من حضرتك بشدة
ولكن هذه المعادلة التى تظهر كلمة حضور وإنصراف هى من تصميمى أنا مبنية على AM & PM من عمود الوردية
ولكن أريد حضرتك ان تنظر الى عمود الوردية فى الملف المستخرج من جهاز البصمة وهو العمود E
فسوف ترى مثلا PM مكررة لأربع مرات لموظف واحد خلال وفى نفس اليوم الواحد__وهذه هى المشكلة التى أواجهها واتمنى من الله وجود حل لها
بارك الله فيك أستاذى ياسر وجزاك كل الخير ولكم جزيل الشكر
واعتذر من حضرتك مرة اخرى

في الصفوف 76 و 77 و 78 و 79 يوجد نفس التاريخ حضور واحد و3 انصراف
ما المتوقع في مثل هذه الحالة؟ هل تريد حذف الصفوف أم ماذا ؟ وإذا كنت ستحذف ما هي الصفوف التي ستحذفها وبأي منطق؟

كده تمام أستاذ ياسر حضرتك معى فى هذه المشكلة
أنا أريد الإبقاء على كل تلك الصفوف الأربعة -ولكن جعل الصف 78 حضور أيضا ,وذلك يعنى ان هذا الموظف استاذن بالخروج ثم عاد وحضر الى العمل مرة أخرى وذلك فى الصف 78 الساعة 01:04 PM وكأن هذا الموظف عمل كفترتين بينهما مدة راحة أى بريك ,أى حضر وانصرف فى أول فترة فى الصفين 76 و 77 -ثم حضر وانصرف فى الفترة الثانية من العمل فى الصفين 78 و 79
هل هناك حل فى ذلك
بارك الله فيكم

جرب الملف التالي عله يفي بالغرض
ها هو الكود المستخدم

Sub Test()
    Dim x           As Variant
    Dim m           As Long
    Dim i           As Long
    Dim c           As Long
    
    Application.ScreenUpdating = False
        With ActiveSheet
            m = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = m To 2 Step -1
                If .Cells(i, 3).Value <> .Cells(i - 1, 3).Value Then
                    c = Application.CountIfs(.Range("C" & m & ":C" & i - 1), .Cells(i, 3).Value, .Range("A" & m & ":A" & i - 1), .Cells(i, 1).Value)
                    If c = 1 Then
                        .Cells(i + 1, 3).EntireRow.Insert
                        x = .Cells(i, 3).Value
                        .Cells(i + 1, 3).Value = DateSerial(Year(x), Month(x), Day(x))
                        .Cells(i + 1, 1).Value = .Cells(i, 1).Value
                        .Cells(i + 1, 2).Value = .Cells(i, 2).Value
                        .Cells(i + 1, 4).Value = .Cells(i, 4).Value
                        .Cells(i + 1, 5).Value = .Cells(i, 5).Value
                        
                        .Cells(i, 7).Value = "حضور"
                        .Cells(i + 1, 7).Value = "انصراف"
                        .Cells(i + 1, 8).Value = "***"
                    ElseIf c = 2 Then
                        .Cells(i, 7).Value = "حضور"
                        .Cells(i + 1, 7).Value = "انصراف"
                    ElseIf c = 3 Then
                        .Cells(i + 1, 7).Value = "حضور"
                    ElseIf c = 4 Then
                        .Cells(i, 7).Value = "حضور"
                        .Cells(i + 1, 7).Value = "انصراف"
                        .Cells(i + 2, 7).Value = "حضور"
                        .Cells(i + 3, 7).Value = "انصراف"
                    End If
                End If
            Next i
        End With
    Application.ScreenUpdating = True
End Sub

كود ولا أجمل ولا أحلى منه موجود-أحسنت أستاذى الكريم وأبدعت ما شاء الله عليك
ولو هناك أعلى من درجة امتياز مع مرتبة الشرف لجعلتها لك استاذى الكريم ياسر ,انه حقا بدون مبالغة كود فوق من رائع وادى كل المطلوب على أكمل وجه
وما ينفعش ان يكون هناك كلام تانى بعد ذلك
بارك الله فيك وجعلك دائما وأبدا مساعدا لإخوانك الذين يطلبون المساعدة وزخرا لنا ان شاء الله ونور قلبك بالإيمان وحشرك مع أعلى الدرجات وأسماهم فى جنات الفردوس الأعلى وحشرك مع من تحب وغفر لك وتاب عليك ورحم والديك ورزقك رزقا طيبا وكثيرا
وجعل هذا العمل فى ميزان حسناتك ومحو سيئاتك وجعله الله وباقى أعمالك سببا فى دخولك الجنة والتمتع بها
جزاك الله كل خير-واى كلام أقوله مش قدر شكرى لك-لك الشكر كله أخى وأستاذى الكريم

السلام عليكم أخى ياسر أرجو مساعدة حضرتك
مش عارف ليه معادلة جلب البيانات من الصفحة المسحوبة من جهاز البصمة الى صفحة موظف ما لا تعمل بدقة
فهى لا تقوم بجلب الوقت الصحيح اللى هو المفروض يكون موجود فى هذا اليوم رجاءا تقوم بالنظر الى الصورة الموضحة
ولكم جزيل الشكر ضبط ومعالجة اخطاء ملف الحضور والإنصراف بجهاز البصمة2.rar

بارك الله فيك أخي الكريم أحمد يوسف وجزاك الله خيراً على كلماتك الطيبة ودعائك الطيب المبارك ، وإن شاء الله لك بمثل ما دعوت لي
*بخصوص الطلب الثاني أفضل طرح موضوع جديد لكل نقطة جديدة لكي يشارك الأعضاء بفعالية أكثر ، ولأنني لا أدري سبب عدم عمل المعادلة بشكل صحيح .. لذا رجاءً تفضل بطرح موضوع جديد حفاظاً على نظام المنتدى وليسهل عملية البحث مستقبلاً إن شاء الله
والحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات
تقبل تحياتي

السلام عليكم أستاذى ياسر أتأسف واعتذر من حضرتك على الإزعاج
ولكنى عندما وضعت الكود فى الملف الأصلى فظهرت مشكلة عند تطبيقه -سأرسل لحضرتك الصور -فالملف أكثر من 7 ميجابايت
بارك الله فيك وجزاك كل خير

السلام عليكم ورحمة الله وبركاته
تم التعديل على الكود ليكون الناتج حضور1 وحضور2 لان المعادله تجمع الحضورين
وعند تغيير حضور بحضور1 بالمعادله ان شاء الله يتحقق المطلوب
وكل الاحترام والتقدير للرائع الاستاذ ياسر خليل على ابداعاته التى لا تنتهى
ونسأل الله ان لا تنتهى ويجزيه عنا كل الخير

Option Explicit

Sub Test()
    Dim x           As Variant
    Dim m           As Long
    Dim i           As Long
    Dim c           As Long
    
    Application.ScreenUpdating = False
        With ActiveSheet
            m = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = m To 2 Step -1
                If .Cells(i, 3).Value <> .Cells(i - 1, 3).Value Then
                    c = Application.CountIfs(.Range("C" & m & ":C" & i - 1), .Cells(i, 3).Value, .Range("A" & m & ":A" & i - 1), .Cells(i, 1).Value)
                    If c = 1 Then
                        .Cells(i + 1, 3).EntireRow.Insert
                        x = .Cells(i, 3).Value
                        .Cells(i + 1, 3).Value = DateSerial(Year(x), Month(x), Day(x))
                        .Cells(i + 1, 1).Value = .Cells(i, 1).Value
                        .Cells(i + 1, 2).Value = .Cells(i, 2).Value
                        .Cells(i + 1, 4).Value = .Cells(i, 4).Value
                        .Cells(i + 1, 5).Value = .Cells(i, 5).Value
                        
                        .Cells(i, 7).Value = "حضور1"
                        .Cells(i + 1, 7).Value = "انصراف1"
                        .Cells(i + 1, 8).Value = "***"
                    ElseIf c = 2 Then
                        .Cells(i, 7).Value = "حضور1"
                        .Cells(i + 1, 7).Value = "انصراف1"
                    ElseIf c = 3 Then
                        .Cells(i + 1, 7).Value = "حضور1"
                    ElseIf c = 4 Then
                        .Cells(i, 7).Value = "حضور1"
                        .Cells(i + 1, 7).Value = "انصراف1"
                        .Cells(i + 2, 7).Value = "حضور2"
                        .Cells(i + 3, 7).Value = "انصراف2"
                    End If
                End If
            Next i
        End With
    Application.ScreenUpdating = True
End Sub