طارق محمود

السلام عليكم
تفضل أخي الملف به المعادلات بالأزرق والأعمدة علي اليسار بالأحمر تستطيع إخفاؤها لكن لاتلغيها فهي داخلة في تركيب المعادلات

الاجازات جودة.xlsx

السلام عليكم
الأفضل تجميع البيانات في ملف واحد ، بل في ورقة واحدة
لكن علي كل حال تستطيع إستخدام الدالة ( في لوك اب) مع خاصية المطابقة التامة 
أي مثل

ABC.xlsx

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

ضبط-كود-توزيع_2.xlsm

الحمد لله
وجزاك الله خيرا

تفضل المطلوب

تغير الفصول.xlsm

السلام عليكم

أخي الكريم
شرح سريع للحل
يمكنك إختيار فترة الترحيل بالدقائق من الأسهم  عند الخلايا N1:N4 والتي تغير بالخلية M2 أو N2 وهي التي تحدد فترة الترحيل بالكود
ثم بإستخدام هذا الكود يتم مقارنة الفترة منذ آخر ترحيل وبناءا عليها يتم أو لايتم عمل النسخ من البيانات
لم أحذف الباينات في الشيت الأول ، فقط نسختها <<يمكن جعل الكود يمسحها بعدما تترحل >>

وفي آخر الكود يطلب تشغيل كود آخر وظيفته تشغيل عداد زمني بالفترة المطلوبة ليطلب بعدها تشغيبل الكود الأول مرة أخري

Sub AutoTarheel()
Sheets(1).Activate
e = Now - [j1]
x = [n2] / 24 / 60

If e >= x Then

    With Sheets(2)
        LR = .[A9999].End(xlUp).Row
        If LR <> 1 Then LR = LR + 1
        [A1:F20].Copy .Cells(LR, 1)
    End With
    [j1] = Now
End If
Call Rept ' for starting timer again
End Sub

Sub Rept()
t = "00:" & Format([n2], "00") & ":00"
Application.OnTime Now + TimeValue(t), "AutoTarheel"
End Sub

 تفضل الملف وبه الكود

dddata.xlsm

السلام عليكم

أخي الكريم
جرب تستخدم هذا الكود
 

Sub nnn()
cycle = WorksheetFunction.CountA([N8:N30]) - 1
If cycle < 2 Then Exit Sub
lr = Cells(999, 1).End(xlUp).Row
    For c = 1 To cycle
        T = Cells(c + 8, "N")
        n = Cells(c + 8, "O")
        old = Cells(c + 8, "P")
        nw = Cells(c + 8, "Q")
        rep = 0
        For r = 9 To lr
            A = Cells(r, "C")
            B = Cells(r, "D")
            If B = old And A = T And rep < n Then
               With Cells(r, "D")
                .Value = nw
                .Interior.Color = 212
               End With
               rep = rep + 1
            End If

        Next r
        
    Next c
End Sub

أو تفضل الملف به الكود

تغير الفصول.xlsm

السلام عليكم
أخي الكريم

إرفق الملف

السلام عليكم

أخي الكريم

لابد من إدراج مثال من بياناتك والشكل الذي عليه البيانات في الشيتين

الأستاذ الفاضل / أحمد الكسادي ( ايو عيد)
تحية طيبة
لم انتبه لمشاركتك القيمة
حيث سألني الأستاذ mostafa sharaf علي الخاص
ولما حللتها له أحببت ان يستفيد غيره من الحل
لذلك وضعت المشاركة هنا ثم انتبهت لبرنامجك العبقري

جزاك الله خيرا

السلام عليكم

تصحيح
ليس ممكن 32 مراقب مع الإستثناءات

فلنتكلم مثلا عن اليوم الأول - الفترة الأولي فقط

الكود سيوزع 16 مراقب في الصف الرابع 
ثم يذهب للصف الخامس (اليوم الأول - الفترة الأولي )
يجد أن مقابل ال 32 مراقب ، منهم 16 بيراقبوا في  الصف الرابع + 2 مثلا إستثناءات = 18 ، الباقي 14 من ال 32
يعني مش ممكن يوفي المطلوب (16)

إذا زودت عدد الملاحظيين إلي 34 لتغطية الإستثناءات يكون الحل ممكن
وكلما زادت الإستثناءات كلما وجب عليك تزويد الملاحظيين

تفضل هذا الملف به الكود الجديد للورقة الثانية (الجديد)
به حل للإستثناءات ولكل مشاكلك إن شاء الله
لكن إذا قللت  عدد الملاحظيين  عن 34 فلن يستطيع الكود إيجاد الحل

التعديل على الكود توزيع اللجان على الملاحظين (2).xlsm

السلام عليكم
لماذا كل هذه التشكيلات الغريبة في الملف .؟ 

الملف كان ممكن يكون أسهل بكثير إذا لم يكن هناك MERGE - WRAPE ... الفونت 60 وأكثر ....

الأفضل إعادة صياغة الملفات بالطريقة العادية ليسهل عمل المعادلات 

تفضل الملف به التعديل

Cashout test Pro2.xlsm

السلام عليكم
السؤال غير واضح
تستطيع مثلا بالتصفية (فلتر) إختياؤ الفراغ

السلام عليكم
أخي الكريم
أنت كسلت أو نسيت !!
تشرح ماتريد
ظننت أن بالملف شرح لما تريد
ولم  أجد شيئا

الملف لايفتح عندي

السلام عليكم

تفضل الملف به  اضافة للكود تمنع اعطاء المراقب فترتان  فى وقت واحد

توزيع الارقام بطريقة عشوائية2.xlsm

السلام عليكم

تفضل
 

=IF(LEN(D3)>=10,"0"&LEFT(B3,2)&"-"&MID(B3,3,100), "0"&LEFT(B3,1)&"-"&MID(B3,2,100))

تفضل أخي

اصناف3.xlsm

السلام عليكم
الأفضل تضع كل الحالات

لذلك وضعت لك الحل من خلال أكثر من كود واحد

الأول : عند تنشيط الورقة 
وهذا يراجع الصفوف من 15 إلي آخر صف ويخفي السطر أوتوماتيكيا بشرطين أن I=0  ، G<>0 أي يكون هناك سداد

الثاني : عند حدث تنشيط الورقة 
وهذا يراجع الصفوف من 15 إلي آخر صف ويخفي السطر أوتوماتيكيا بشرطين أن I=0  ، G<>0 أي يكون هناك سداد

الثالث : Un-Hide
كود عادي ليس خاص بأحداث الورقة
وهذا يظهر كل السطور التي تم إخفاؤها من قبل

بالإضافة إلي كود رابع في حدث الملف عند فتح الملف يتم تفعيل الكود الأول

إليك الأكواد والملف به الأكواد

Private Sub Worksheet_Activate()
LR = [I9999].End(xlUp).Row
If LR < 15 Then LR = 15

For r = 15 To LR
   If Cells(r, "I") = 0 And Cells(r, "G") <> 0 Then Rows(r).EntireRow.Hidden = True
Next r

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
r = Target.Row
If Cells(r, "I") = 0 And Cells(r, "G") <> 0 Then Rows(r).EntireRow.Hidden = True
End Sub

Sub un_Hide()
LR = [I9999].End(xlUp).Row

Rows(10 & ":" & LR).EntireRow.Hidden = False

End Sub


'===============================================================
Private Sub Workbook_Open()
Sheets ("كشف الحساب ")
LR = [I9999].End(xlUp).Row
If LR < 15 Then LR = 15

For r = 15 To LR
   If Cells(r, "I") = 0 And Cells(r, "G") <> 0 Then Rows(r).EntireRow.Hidden = True
Next r
End Sub

اخفاء السطر.xlsm

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

أخي الكريم

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

Sub nn()
For sh = 1 To Sheets.Count
    With Sheets(sh)
        LR = .[C9999].End(xlUp).Row
        .Range("A" & LR & ":H" & LR).Copy
        .[A17].PasteSpecial xlPasteValues
        With .Range("A18:H" & LR)
            .ClearContents
            .Interior.ColorIndex = xlNone
            
        End With
    End With
Next sh
End Sub

ومرفق أيضا الملف وبه الكود

اصناف2.xlsm

أخي الكريم
لا أعتقد  أن هناك خطأ
لكن انظر لهذه الصورة لضبط خيار التحديث

السلام عليكم
تفضل المرفق به الشرح والمعادلات المطلوبة

الشكاوى.xlsm

السلام عليكم
أخي الكريم

اولا :  مبروك على التطوير

لم أفهم أي تطوير ، لكن بارك الله فيك في جميع الأحوال
 

ثانيا: الملف الثاني كمان معطوب
برجاء الإرسال بصيغة xls عادي سيقبل المنتدي

أو لو استطاع أحد الإخوة فتح أي من الملفين يتفضل بإعادة رفع الملف مفكوك

أخي الكريم
عند تغيير أي بيان في البيانات الأصلية لايظهر ذلك في pivot table إلا بعد أن تعمل تحديث لل pivot table نفسه
أسهل طريقة لعمل التحديث Refresh عن طريق الضغط علي الزر الأيمن للماوس وأنت داخل ال pivot table
أنظر الصورة

ومن الممكن إذا كان التغيير كثيرا وقد يحدث نسيان منك أو من المستخدم ، أقصد نسيان عمل التحديث Refresh 
ممكن في هذه الحالة عمل كود صغير بالورقة التي بها ال  pivot table تجعل عمل التحديث Refresh يتم أوتوماتيكيا كلما فتحت تلك الورقة