سعيد بيرم قام بنشر الإثنين at 18:53 مشاركة قام بنشر الإثنين at 18:53 السلام عليكم ورجمة الله وبركاته وجزاكم الله تعالى خير الجزاء وبارك فيكم جميعا نطمع من حضراتكم فى إيجاد حل لهذا الموضوع بإستخدام كود VBA أو دالة معرفة UDF Function حيث يحتوى المرفق على خليتين أحدهما لتاريخ بداية والأخرى لتاريخ نهاية علما بأنه سيتم تسجيل هذين التاريخين يدويا والسؤال كيف يمكن إنشاء قائمة بتسلسل الأيام وبدون أيام الجمعة والسبت من تاريخ بداية إلى تاريخ نهاية حسب مقتضيات العمل برجاء الإطلاع على العينة المرفقة والله الموفق وجزاكم الله خيرا تسلسل الأيام بدون أيام الجمعة والسبت.xlsm رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الإثنين at 19:05 مشاركة قام بنشر الإثنين at 19:05 11 دقائق مضت, سعيد بيرم said: تاريخ بداية إلى تاريخ نهاية هل بداية الشهر او التاريخ المدخل رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الإثنين at 19:47 الكاتب مشاركة قام بنشر الإثنين at 19:47 أخى محمد مساء الأنوار ردا على سؤال حضرتك التاريخ المدخل وليس بداية الشهر رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الإثنين at 19:59 مشاركة قام بنشر الإثنين at 19:59 (معدل) تفضل جرب هل هدا ما تقصده Option Explicit Sub CreateDaysList() Dim Linge&, dCount& Dim startDate As Date, endDate As Date, n As Long Dim tmp As Date, cnt As String Dim sh As Worksheet: Set sh = Sheets("Sheet1") ' تحديد أقصى عدد للأيام المستخرجة Dim maxDays As Long: maxDays = 30 startDate = sh.[L2].Value: endDate = sh.[M2].Value If IsEmpty(sh.[L2].Value) Or IsEmpty(sh.[M2].Value) Or _ Not IsDate(sh.[L2].Value) Or Not IsDate(sh.[M2].Value) Or _ sh.[L2].Value > sh.[M2].Value Then MsgBox "تاريخ البداية أو النهاية غير صحيح", vbExclamation: Exit Sub End If tmp = startDate n = 0 Do While tmp <= endDate If Weekday(tmp) <> vbFriday And Weekday(tmp) <> vbSaturday Then n = n + 1 End If tmp = tmp + 1 Loop If n > maxDays Then MsgBox "عدد الأيام المستخرجة " & vbCrLf & _ "يتجاوز الحد الأقصى " & maxDays, vbExclamation Exit Sub End If Application.ScreenUpdating = False sh.Range("K6:L100").ClearContents Linge = 6 tmp = startDate dCount = 0 Do While tmp <= endDate If Weekday(tmp) <> vbFriday And Weekday(tmp) <> vbSaturday Then cnt = Choose(Weekday(tmp), "الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس") sh.Cells(Linge, "L").Value = Format(tmp, "yyyy/mm/dd") sh.Cells(Linge, "K").Value = cnt Linge = Linge + 1 dCount = dCount + 1 End If tmp = tmp + 1 Loop Application.ScreenUpdating = True End Sub تسلسل الأيام بدون أيام الجمعة والسبت 2.xlsm تم تعديل الإثنين at 20:04 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
عبدالله بشير عبدالله قام بنشر الإثنين at 20:32 مشاركة قام بنشر الإثنين at 20:32 السلام عليكم اثراء للموضوع وتنوع الحلول وبعد اذن استاذنا الفاضل محمد هشام الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("L2:M2")) Is Nothing Then Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim outputRow As Long startDate = Me.Range("L2").Value endDate = Me.Range("M2").Value outputRow = 6 Me.Range("K6:L" & Me.Rows.Count).ClearContents For currentDate = startDate To endDate If Weekday(currentDate, vbSunday) <> 6 And Weekday(currentDate, vbSunday) <> 7 Then Me.Cells(outputRow, 11).Value = Format(currentDate, "dddd") Me.Cells(outputRow, 12).Value = currentDate outputRow = outputRow + 1 End If Next currentDate End If End Sub الملف تسلسل الأيام بدون أيام 2الجمعة والسبت.xlsm 1 رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الإثنين at 20:41 الكاتب مشاركة قام بنشر الإثنين at 20:41 (معدل) زادكم الله فضلا واحتراما وأدبا أخى محمد كفيت ووفيت وجزاكم الله تعالى خير الجزاء تقبل وافر تقديرى واحترامى تم تعديل الإثنين at 21:08 بواسطه سعيد بيرم رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الإثنين at 21:08 الكاتب مشاركة قام بنشر الإثنين at 21:08 زادكم الله فضلا واحتراما وأدبا أخى عبدالله كفيت ووفيت وجزاكم الله تعالى خير الجزاء تقبل وافر تقديرى واحترامى 1 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الإثنين at 22:50 مشاركة قام بنشر الإثنين at 22:50 (معدل) العفو اخي @سعيد بيرم هدا الملف يتضمن نفس الفكرة مع استخراج الايام بداية من يوم الاحد على عمود A:B ادراج أيام الشهر كاملا all .xlsm تم تعديل الإثنين at 22:51 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الثلاثاء at 00:04 الكاتب مشاركة قام بنشر الثلاثاء at 00:04 (معدل) والله العظيم أستاذ ورئيس قسم يا إبنى تسمح تجيب إيديك يا أبنى ابوسها ههههههههههه ياللاه زى بعضة رغم أننى ستون عاما من العمر لكنك فى القلب وربنا يبارك فى عمرك طيب ياسيدى وارد جدا أن تتطلب مقتضيات العمل أن نعمل على سبيل المثال لمدة شهرين من 2024/10/1 حتى 2024/11/30 كيف يمكن أن نقوم بعملية إنشطار لهذه القائمة إلى قائمتين متجاورتين والسبب هو الحفاظ على حدود وهوامش الصفحة عند عملية الطباعة لمزيد من التوضيح برجاء الإطلاع على المرفق لمعرفة ما أعنيه ادراج أيام الشهر كاملا all +111.xlsm تم تعديل الثلاثاء at 00:36 بواسطه سعيد بيرم رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالله بشير عبدالله قام بنشر الثلاثاء at 05:47 أفضل إجابة مشاركة قام بنشر الثلاثاء at 05:47 (معدل) السلام عليكم ورحمة الله وبركاته صباح الخير الاستاذ سعيد بما اننا في نفس العمر تقريبا 61 سنة واشتراكنا بالمنتدى تقريبا فى نفس السنة بفارق عام اهديك هذا الملف مع تحياتنا الخالصة لاخينا الاستاذ محمد هشام وادعو الله ان يمدكما بطول العمر ويمتعكما بالصحة وراحة البال والرزق الوفير بمكن كتابة تاريخ البدابة والتهاية يدوبا في L2 -N2 فتتم العملية الزر في الصفحة اخنياري ولبس اساسى مهمته انك تكتب تاربخ البداية بدويا ثم تكتب عدد الايام المراد اظافتها الى التاريخ في N3 ثم اضغط على الزر فبظفها الى تاريخ النهاية تحياتى لكما ولكل اخوتنا في هذا المنتدى انقسام الشهور على قائمتبن.xlsm تم تعديل الثلاثاء at 13:48 بواسطه عبدالله بشير عبدالله 2 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الثلاثاء at 14:50 مشاركة قام بنشر الثلاثاء at 14:50 (معدل) 15 ساعات مضت, سعيد بيرم said: وارد جدا أن تتطلب مقتضيات العمل أن نعمل على سبيل المثال لمدة شهرين من 2024/10/1 حتى 2024/11/30 كيف يمكن أن نقوم بعملية إنشطار لهذه القائمة إلى قائمتين متجاورتين بصراحة اخجلتني بكلامه هدا فأنت تقريبا بعمر والدي بارك الله لك في عمرك و عملك و صحتك و اتم عليك نعمته و رزقك سعادة الدارين أنت وأستادنا @عبدالله بشير عبدالله له خالص تقديري وامتناني على المجهود المتواصل لمساعدة الإخوة الأعضاء كما يسعدني ويشرفني ولي الفخر أني قد شاركت معكم حل هدا الموضوع ما قام به أستادنا عبد الله يوفي بالغرض 1) ما جعلني أقوم بتعديل الكود الخاص بي على حسب متطلباتك الجديدة هو أنني بعد تجربة الملف الدي زودنا به أستادنا لاحظت هفوات بسيطة بطريقة الحساب في حالة كان عدد الايام المستخرجة اكبر من 64 صف مثال لو قمنا بادخال تاريخ البداية 2024/10/22 تاريخ النهاية 2025/01/20 النتائج تظهر بشكل خاطئ وعند إنقاص يوم تصبح صحيحة 2) ضرورة إظافة شرط التحقق من التواريخ الصحيحة تفاديا للاخطاء خاصة انك ستقوم بإدخال التواريخ يدويا 3) تعريب أسماء الأيام جرب هدا Sub CreateDaysList() Dim startDate As Date, endDate As Date Dim xDate As Date, xCount As Long, cnt As Long, tmp As Long Dim sh As Worksheet: Set sh = Sheets("Sheet1") If IsEmpty(sh.[L2].Value) Or IsEmpty(sh.[N2].Value) Or Not IsDate(sh.[L2].Value) Or Not IsDate(sh.[N2].Value) Then MsgBox "يرجى إدخال تواريخ البداية والنهاية بشكل صحيح", vbExclamation Exit Sub End If startDate = sh.[L2].Value endDate = sh.[N2].Value If startDate > endDate Then MsgBox "تاريخ البداية يجب أن يكون أقل أو يساوي تاريخ النهاية", vbExclamation Exit Sub End If xDate = startDate cnt = 6 tmp = 0 xCount = 0 Application.ScreenUpdating = False With sh.Range("K6:N64") .FormatConditions.Delete .ClearContents End With Do While xDate <= endDate And xCount < 64 If Weekday(xDate, vbSunday) <> vbFriday And Weekday(xDate, vbSunday) <> vbSaturday Then sh.Cells(cnt, 11 + tmp).Value = Choose(Weekday(xDate, vbSunday), _ "الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس") sh.Cells(cnt, 12 + tmp).Value = Format(xDate, "yyyy/mm/dd") cnt = cnt + 1 xCount = xCount + 1 If cnt > 37 Then tmp = 2 cnt = 6 End If End If xDate = xDate + 1 Loop Call crc(sh.Range("K6:K37"), "=K6=""الأحد""", RGB(255, 255, 0)) Call crc(sh.Range("M6:M37"), "=M6=""الأحد""", RGB(255, 255, 0)) Application.ScreenUpdating = True End Sub Sub crc(rng As Range, condition As String, color As Long) With rng.FormatConditions.Add(Type:=xlExpression, Formula1:=condition) .Interior.color = color End With End Sub ادراج أيام الشهر كاملا V4 .xlsm وفي حدث ورقة 1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim sh As Worksheet: Set sh = Me If Not Intersect(Target, sh.Range("L2:N2")) Is Nothing Then Call CreateDaysList End If End Sub تم تعديل الثلاثاء at 15:14 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الثلاثاء at 18:02 الكاتب مشاركة قام بنشر الثلاثاء at 18:02 بسم الله الرحمن الرحيم وبه نستعين أخى وأستاذى / عبدالله بشير ما أجمل هدايكم المباركة والأجمل منها هى أن المولى العلى القدير أهدانى أخ كريم طيب النفس فلك منى خالص التحية والتقدير والإمتنان عما تقدمه للجميع هنا فتقبل الله تعالى منك صالح الأعمال وجزاكم الله تعالى عنا خير الجزاء رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الثلاثاء at 18:19 الكاتب مشاركة قام بنشر الثلاثاء at 18:19 (معدل) بسم الله الرحمن الرحيم وبه نستعين أخى وأستاذى / محمد هشام حبيب قلبى ربنا يبارك فى والديك أولا ويبارك فى عمرك فاأنت وبحق من خيرة شباب الشقيقة المغرب فبارك الله فى شبابك وأسعدكم الله تعالى فى الدارين فكم أنا فخور بك ولدى العزيز الغالى فلك منى خالص التحية والتقدير والإمتنان عما تقدمه للجميع هنا فتقبل الله تعالى منك صالح الأعمال وجزاكم الله تعالى عنا خير الجزاء تم تعديل الثلاثاء at 18:21 بواسطه سعيد بيرم 1 رابط هذا التعليق شارك More sharing options...
سعيد بيرم قام بنشر الثلاثاء at 19:09 الكاتب مشاركة قام بنشر الثلاثاء at 19:09 أخى وأستاذى / عبدالله بشير أخى وأستاذى / محمد هشام تم وبحول الله تعالى تجربة كلا الكودين وقد وفيتم وكفيتم وجزاكم الله تعالى عنا خير الجزاء رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان