أ / محمد صالح

الشكر لله الذي بنعمته تتم الصالحات

جميعا بإذنه تعالى

تفضل تم إجراء تعديلين المدى الذي يتم مسحه والعمود F وما بعده بالتوفيق Search++ - Copy.xlsm

إن شاء اللّه يفيدك هذا الكود Sub mas() Application.ScreenUpdating = 0 Dim lr1 As Long, lr2 As Long, r As Long, c As Long, n As Long lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row Sheet2.Rows("4:" & IIf(lr2 < 4, 4, lr2)).Delete Shift:=xlUp For r = 6 To lr1 c = 0 Sheet1.Select lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row If Evaluate("=COUNTIF($E$6:E" & r & ",E" & r & ")") = 1 Then Sheet1.Range("A5:N5").Copy Sheet2.Select Sheet2.Range("A" & lr2 + 2).Select ActiveSheet.Paste Application.CutCopyMode = False Sheet2.Range("f" & lr2 + 1) = Sheet1.Range("e" & r) Sheet2.Range("a" & lr2 + 2) = c + 1 Sheet2.Range("b" & lr2 + 2 & ":N" & lr2 + 2).Value = Sheet1.Range("b" & r & ":N" & r).Value c = c + 1 For n = r + 1 To lr1 If Sheet1.Range("e" & n) = Sheet1.Range("e" & r) Then lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row Sheet2.Range("A" & lr2 & ":N" & lr2).Copy Range("A" & lr2 + 1).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Sheet2.Range("a" & lr2 + 1) = c + 1 Sheet2.Range("b" & lr2 + 1 & ":N" & lr2 + 1).Value = Sheet1.Range("b" & n & ":N" & n).Value c = c + 1: Sheet2.Range("A4").Select End If Next n End If Next r Sheet2.Select Application.ScreenUpdating = 1 MsgBox "Done by mr-mas.com" End Sub وهذا ملفك بعد التعديل بالتوفيق الترحيل على حسب الوظيفة.xlsm

إن شاء اللّه يفيدك هذا المرفق بيان العجز والزيادة.xlsx

إن شاء اللّه يفيدك هذا الموضوع برنامج مفتوح المصدر

أعتقد سبقت الإجابة عن هذه النقطة بهذا المقترح هذا الشيت هو الأساس الذي يتم فيه التسجيل وباقي الشيتات تبحث فيه وتعرض منه ما يوافق شروط البحث بالتوفيق

أخي الكريم من أساسيات البرمجة : * في حالة اختيار المستخدم لبديل واحد فقط يتم استخدام option button * في حالة اختيار المستخدم لأكثر من بديل نستخدم check box بوضوح أكثر: في مثل حالتك هذه يجب استخدام option button لأنك في الأخير تريد أن يكون عنصر واحد فقط هو المحدد بالتوفيق

حسب فهمي للمطلوب إن شاء اللّه يكون هذا مطلوبك الثاني Sub hideblank() For n = 2 To 151 Columns(n).Hidden = Iif(Cells(5, n) = "",True,False) Next n End Sub Private Sub Worksheet_Activate() hideblank End Sub بالتوفيق

المنتدى هنا مليء بموضوعات تعليمية وشرح مصور وفيديو يحتاج فقط من يبحث عنها كنوووووز

آمين ولك بالمثل ويزيد

عليكم السلام و رحمة الله وبركاته تنسيق رائع بارك الله لك اقتراحاتي: * وجود شيت تسجيل بيانات الدوام ويكون فيه مسلسل ورقم الموظف وأربعة أوقات دخول وخروج (Maint & apres M) وتاريخ اليوم وأي ملاحظات أخرى * تعديل شكل التقرير الشهري ليكون رأسيا ولموظف واحد وكذلك السنوي (طالما تحرص على عرض 4 أوقات) لكن إذا كان الهدف عرض إجمالي التأخير أو الإضافي بدون التوقيتات الأربعة فيمكن عمل التقرير أفقيا بالتوفيق

جميعا بإذن الله أنا ما فعلت شيئا سوى ضبط بعض الجمل في ترتيبها حتى الزميل قلب الأسد قام بتعريف المتغيرات واختصار بعض السطور فقط بالتوفيق

يمكنك استعمال هذا الكود للإخفاء Sub hideblank() For n = 2 To 151 If Cells(5, n) = "" Then Columns(n).Hidden = True Next n End Sub وهذا لإظهار الكل Sub showblank() Columns("b:eu").Hidden = False End Sub بالتوفيق

جرب أن تحذف هذا السطر فهو لحذف عمليات الترتيب السابقة

الخطأ في الكود الأصلي أنا فقط قمت بإعادة ترتيب أوامره في أي سطر يظهر الخطأ؟

الكود صحيح ما دام يعمل على بعض الأجهزة ولا علاقة له بنسخة 64 أو 32 ولكن به بعض من عدم الترتيب جرب هذا التعديل في ترتيب الأكواد Sub ترتيبي() Prompt = "إذا أردت الإستمرار فانتظر لأن الترتيب يأخذ بعض الوقت " Command_buttons = vbYesNo + VbMsgBoxRt1Reading Title = "هل تريد ترتيب البيانات بعد التغيرات الجديدة ؟؟ " project = MsgBox(Prompt, Command_buttons, Title) If project = vbYes Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With ActiveWorkbook.Worksheets("master").Sort .SortFields.Clear .SortFields.Add2 Key:=Range("BV8:BV6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal .SortFields.Add2 Key:=Range("BT8:BT6053"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= xlSortNormal .SortFields.Add2 Key:=Range("C8:C6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal .SetRange Range("B8:BW6053") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Call MsgBox(" تم الترتيب بنجاح ", mBox, "الحمد لله ") Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End If End Sub بالتوفيق

جميعا بإذن الله

نظرا لوجود معادلة في العمود F ويكون ناتجها 0 في حالة عدم وجود أرقام ينبغي تعديل معادلة العد في الخلية R4 إلى =COUNTIFS(B:B,Q4,F:F,">"&0) بالتوفيق

بعد مراجعة هذا الجزء ستتوصل إلى أن 4000 ضمن 1٪ أما 4001 فهي ضمن 1.5٪ كما أن صاحب الاستفسار ما أشار إلى أن المتبقي من المبلغ بعد الشريحة السابقة يضرب في نسبة كذا ولكن قال يضرب المبلغ في نسبة كذا

لا يوجد حلقات مفقودة تم تعديل حل أستاذ سليم في نسب الخصم من أستاذ بن علية وهذا تعديل بداية ونهاية الخصم ويمكن استعمال دالة trunc أو round للحصول على عدد المنازل العشرية المطلوب في المبلغ إن شاء اللّه هو المطلوب بالتوفيق نسب شرائح الخصم.xlsx

أخي الكريم اعذرني طريقة تنظيم الملف لا تساعد في الوصول للمطلوب تحتاج أولا إلى استعمال تنسيق الوقت 24 لضبط مواعيد الفترة الثانية وكل المواعيد بعد 12 ظهرا لأنها مثلا تعتبر 12:45 أكبر من 1:00 وأقترح توفير عمودي موعد الحضور في الفترتين وكتابتهم في خليتين أعلى الجدول لأنهم ثابتان طوال الشهر بعد الحصول على مدة التأخير الصحيحة يمكن عمل الشروط الخاصة بالخصم عليها فيما يخصص دقائق التأخير وهذه معادلة مقترحة لحساب تأخير 1 وتأخير 2 بالتوفيق دوام ماهر الغيلي.xlsx

جرب حذف = التي قبل address أو إن شاء الله يفيدك هذا الموضوع المشابه بالتوفيق

أخي الكريم تركيبة الملف لا تسمح بعمل معادلة واحدة للجميع يتم سحبها أفقيا ورأسيا لذلك يتم تحديد عمود المنتج الخاص بالفرع واستعماله في المعادلة فمثلا المنتج الرابع في الفرع الثاني عموده j لذلك معادلة العدد =COUNTIFS(L:L,O15,J:J,"<>") ومعادلة المبلغ =SUMIFS(J:J,L:L,O15) بالتوفيق

الحلقة التكرارية تتوقف مع نهاية عدد كلمات المستند