سليم حاصبيا

تم معالجة الامر و لكن عدد ايام العمل تم ادراجه في الخلية B5 لعدم اخفاءه في حال وقع تحت عامود مخفي بالنسبة للتورايخ يمكن ادراج كل العطل خلال العام كاملاً و اكسل يقوم بادراجها حسب الشهر المناسب واذا حدث يوم تعطيل قسري يمكن اضافتة ابضاً العمل ضمن النطاق AZ100 : AZ2 كشف Salim A3yad1.xlsm

تم اضافة الاعياد والعطل القسرية الى الملف (يجب ادراج تاريخها في العامود AZ ابتداءً من الصف الثاني) كشف Salim A3yad.xlsm

اشارة التعجب هذه تدل على ان الملف يحتوي على ماكرو هذا كل ما فيه

اكثر من رائع احي بن علية\ بقي شيء واحد يجب اتمامه وهو حماية الخلايا غير الفارغة من الشيت المذكور لعدم التلاعب بالنتائج من قبل الفضوليين (اذ يجوز ان يقوم اجدهم بحذف الغياب لنفسه او لأحد اخر) او يمكن ان يتم ذلك عن طريق خطا غير مقصود من قبل المستخدم يمكن الاستعانة بالكود في مشاركتي على هذا العنوان https://www.officena.net/ib/topic/84508-حماية-الخلايا-غير-الفارغة-بواسطة-باسوورد/

ممكن ذلك شاهد هذا الملف (العملية تتم عند كبسة اليمين وليس دوبل كليك في نطاق محدد ) كله قابل للتغيير حسب المطلوب Right_Click.xlsm

جرب هذا الكود Option Explicit Sub give_data() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim arr(), m%: m = 1 Dim k%, i% Dim st$ Dim x% Dim Source_sh As Worksheet: Set Source_sh = Sheets("Data") Dim targ_sh As Worksheet: Set targ_sh = Sheets("Data1") targ_sh.Range("e4").CurrentRegion.Offset(1).ClearContents k = Source_sh.Range("d4").CurrentRegion.Rows.Count + 3 For i = 5 To k If Application.CountIf(Source_sh.Range("F5:F" & i), Source_sh.Range("F" & i)) = 1 Then ReDim Preserve arr(1 To m): arr(m) = Source_sh.Range("F" & i) m = m + 1 End If Next targ_sh.Range("E4").Resize(m - 1) = Application.Transpose(arr) For m = LBound(arr) To UBound(arr) For i = 5 To k If Source_sh.Range("f" & i) = arr(m) Then st = st & Source_sh.Range("G" & i) & Chr(10) End If Next st = Mid(st, 1, Len(st) - 1) targ_sh.Range("f" & m + 3) = st targ_sh.Range("f" & m + 3).WrapText = True st = "" Next x = Application.Max(targ_sh.Range("B:B")) + 3 targ_sh.Range("d4:d" & x).Formula = _ "=INDEX(Data!$E$5:$E$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("G4:G" & x).Formula = _ "=INDEX(Data!$H$5:$H$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("H4:H" & x).Formula = _ "=INDEX(Data!$I$5:$I$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("I4:I" & x).Formula = _ "=INDEX(Data!$J$5:$J$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("d4:I" & x).Value = targ_sh.Range("d4:I" & x).Value Erase arr With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub بالنسبة للجدولين في الورقة الاولى تم عمل المعادلات للجدول الاول فقط (لضيق الوقت) يمكن عمل المعادلات للجدول الثاني بنفس الصيغة الملف مرفق Data _salim.xlsm

اذا اردت الكتابة في سطر ثاني او ثالث الح... في خلية واحدة عتد نهاية السطر اضغط Alt+Entr و تابع الكتابة ,و نفس الشيء عند كتاية السطر الثالث لا تنس ان تحدد الخلية و تضغط على Wrap Text من التيويب Home

ملف جيد و الى الامام لكن ارجو تقبل بعض الملاحظات: 1- لا ضرورة لتحميل ملف كبير بهذا الشكل يكفي ملف صغير مختصر 20 الى 30 صف (نموذج ) والذي يريد اضافة معلومات يكون الامر متاحاً له 2- لا ضرورى لادراج التواريخ يدوياً في كل صفحة من صفحات الشهور (يكفي عمل نسخات (12 نسخة) عن الورقة Salim من هذا الملف واختيار الشهر والسنة و بوم العطلة في كل نسخة) ثم تسمية هذه الصفحات باسماء الشهور اذا اردت ليقوم اكسل بادراج التواريخ ألياً (كما في الصفحة Salim) مع حساب الشهر 28و29و30 أو 31 و تاوين يوم العطلة كما تحدده في الخلية A3 3 -هذه الورقة صالحة لكل الاعوام الدراسية (يكفي تغيير السنة فقط من الخلية A1) في كل صفحة من صفحات الشهور الملف (كنموذج) مرفق كشف Salim.xlsm

هذا الملف مع المعادلة test_salim.xlsx

يا اخي لم افهم حتى الان ماتريد ارسل ملفاً بالمهطيات و بالنتائج المتوقعة

ربما هذه تالمعادلة =INDEX($B$5:$F$100,MATCH($K5,$A$5:$A$100,0),MATCH(L$4,$B$4:$F$4,0))

ربما ينال الاعحاب هذا الملف (معادلات) موادالرسوب++Salim.xlsx

هذا الماكرو يقوم بالمطلوب Option Explicit Sub Give_Data() Dim MY_arr$ Dim my_st$: my_st = "غائب" Dim i%, j%, K%: K = Range("d6").CurrentRegion.Rows.Count + 5 Dim t%: t = 2 Range("q6").Resize(K - 5, 1).ClearContents For i = 6 To K For j = 6 To 13 If Cells(i, j) <> "" And (Cells(i, j) = my_st Or Cells(i, j) < 50) Then MY_arr = MY_arr & Cells(i, j).Offset(-t) & " " End If Next Cells(i, 17) = MY_arr MY_arr = "" t = t + 1 Next End Sub الملف مرفق موادالرسوب.xlsm

بداية كل عام وانتم والأمة العربيّة والاسلامية بخير طلب مني احد الأصقاء تنظيم الديون في محله لمعرفة كل زبون ما عليه بالاضافة الى جرد ديون زبون محدد (حسب الاختيار من قائمة منسدلة) فكان هذا الملف الذي عسى ان يستفيد منه اكبر عدد من الأعضاء ورقة العمل محمية لعدم العبث بالمعادلات عن طريق الخطأ في الملف (بدون باسبوورد) تستطيع الكتابة فقط في العامودين C & D حتى الصف رقم 100 و استخدام القائمة المنسدلة في الخلية F2 لتوسيع نطاق العمل يجب التعديل على المعادلات و هذا شيء بسيط لمن يريد نطاق أكبر للعمل الأسماء في جدول الجرد مرتبّة حسب قيمة الديون تنازلياً (وهنا المعادلات تلعب دورها) اذ انه ليس مجرد SumIfs القائمة المنسدلة في F2 "مطاطة" بمعنى انها: 1-تتجاهل الفراغات 2- لا تذكر الاسم المكرر الا مرة واحدة 3- تستجيب لاي تعديل او تغيير في الجدول الرئيسي Salim_Sum WITH PROTECTION.xlsx

جرب هذا الملف Salim_Sum.xls

لم أفهم قصدك هل جدول المعطيات غير ثابت اذا كان ذلك يلزم معالجات اخرى

هذه المعادلة انسخها الى الخلية L5 واسحب الى اليسار مقدار 5 أعمدة =INDEX(F$5:F$17,MATCH($K5,$A$5:$A$17,0))

ماكرو مختصر اكثر (بدون أرقام) Private Sub ComboBox1_Change() Dim x% x = Application.Match(ComboBox1.Text, Range("r1:r12"), 0) ComboBox2.ListFillRange = Range("R" & x & ":R" & 12).Address End Sub

جرب هذا الماكرو (يحب ان تضع الارقام من 1 الى 12 ) في العامود S ابتداء من S1 Private Sub ComboBox1_Change() Dim x%, i% ComboBox2.Clear x = Application.VLookup(ComboBox1.Text, Range("r1:s12"), 2, 0) For i = x To 12 ComboBox2.AddItem Range("r" & i).Value Next End Sub

صع هذا المعادلة في E8 F8=

غير MAX الى COUNTA لتصبح المغادلة هكذا =IF(ROWS($A$1:A1)>COUNTA($H$7:$I$50),"",IF(ROWS($A$1:A1)<=COUNTA($H$7:$H$50),H7,OFFSET($I$7,COUNTA($N$6:N6)-COUNTA($H$7:$H$50),))) او هذه =IF(ROWS($A$1:A1)>COUNTA($H$7:$I$50),"",INDEX($H$7:$I$50,MOD(ROWS($A$1:A1)-1,COUNTA($H$7:$H$50))+1,INT((ROWS($A$1:A1)-1)/COUNTA($H$7:$H$50))+1)) الملف الجديد New_Boo;k.xlsx

طبعاً ممكن Book_Salim2.xls

اذا كنت تريد يمكن عمل هذا بالمعادلات اكتب هذه المعادلة اينما تريد و اسحبها نزولاً =IF(ROWS($A$1:A1)>COUNTA($H$7:$I$50),"",INDEX($H$7:$I$50,INT((ROWS($A$1:A1)-1)/2)+1,MOD((ROWS($A$1:A1)-1),2)+1)) الملف المرفق فيه المعادلة والنتيجة Book_Salim1.xls

لا تسنطبع تجزئة الماكرو و توفقه عن عمله في مننتصف الكود اذ انه قام بنسخ العامود الاول و يجب عليه ان يلصقه في مكان ما قبل ان يقوم بنسخ العامود الثاني الى مكان أخر يمكن عمل ذلك من خلال InputBox ,ولكن ذلك من الماكروات المتقدمة بعض الشيء ( وانت ما زلت مبتدءأً أصبر قليلاً) بانسبة للخلية الفارغة ممكن معالجة الامر و ذلك باستبدال Range("a2").Offset(My_RG.Columns(1).Rows.Count) بهذا السطر Range("a2").Offset(My_RG.Columns(1).Rows.Count-1) هذا الفيديو لا يقوم على النسخ واللصق بطريقة الماكرو

جرب هذا الكود (نستطيع ان تحدد اي خلية غير A2 للصق فيها) Option Explicit Sub COPY_CELLS() Sheets("النتيجه").Range("a2").CurrentRegion.Clear Dim My_RG As Range Set My_RG = Sheets("Sheet1").Range("h6").CurrentRegion My_RG.Columns(1).Copy Sheets("النتيجه").Range("a2") My_RG.Columns(2).Copy Sheets("النتيجه"). _ Range("a2").Offset(My_RG.Columns(1).Rows.Count) End Sub