khairi ali قام بنشر أبريل 18, 2019 مشاركة قام بنشر أبريل 18, 2019 السلام عليكم لو تكرمتم الرجاء الاجابة على السؤال في الملف المرفق وشكرا المصنف1.xlsm رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 18, 2019 مشاركة قام بنشر أبريل 18, 2019 ربما يكون الحل Option Explicit Sub Get_days() Dim i%, k%, m%, it Dim arr(), cont Dim st$ Dim Days_num% Dim arr_arab(1 To 7) arr_arab(1) = "الأحد": arr_arab(2) = "الإثنين": arr_arab(3) = "الثلاثاء" arr_arab(4) = "الأربعاء": arr_arab(5) = "الخميس": arr_arab(6) = "الجمعة" arr_arab(7) = "السّبت" Dim dict As Object m = 1 Set dict = CreateObject("Scripting.Dictionary") For i = 5 To 16 If Range("c" & i) <> "" Then With dict cont = Split(Range("c" & i), "-") .Add i - 4, cont For Each it In .Items ReDim Preserve arr(1 To 1) arr(1) = it Range("e" & i) = UBound(cont) + 1 For k = UBound(cont) To 0 Step -1 Days_num = Weekday(DateSerial([E2], i - 4, cont(k))) st = st & arr_arab(Days_num) & "," Range("g" & i) = Left(st, Len(st) - 1) & "." Next Next .RemoveAll Erase arr st = vbNullString End With End If Next End Sub الملف مرفق khairi ali.xlsm 2 رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر أبريل 18, 2019 الكاتب مشاركة قام بنشر أبريل 18, 2019 مشكور أستاذ سليم ولكن هناك خطأ عندما قمت بتغير السنة إلى 2018 ظهر الخطأ كما في الصورة رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 ما شاء الله استاذ سليم كود فى عاية الجمال والروعة بعد اذن استاذ سليم ضيف هذه الجمله فى اول الكود On Error Resume Next رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 احي مصطفى لا داعي للسطر الذي قلت عنه لانه في الكود مذكور أن يتجاوز الخلايا الفارغة ) المطلوب فقط ان تترك الخلية فارغة ولا يتم وضع لا " 0" ولا " -" ولا اي شيء آخر يتم ادراج فقط ارقام من 1 الى نهاية الشهر حسب الخلية المناسبة في العامود C يتوسط الرقمين "-" للتوضيح هذه الصورة 2 رابط هذا التعليق شارك More sharing options...
احمد بدره قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 رائع أستاذنا الفاضل الأستاذ / سليم أرى أن يتم استبدال العلامة "-" بفاصلة " ,"لأنه أحيانًا لو كان الغياب يومان يتحول إلى تاريخ وقم بتجربتها فكانت بلا مشاكل khairi ali.xlsm 1 رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر أبريل 19, 2019 الكاتب مشاركة قام بنشر أبريل 19, 2019 مشكورين جدا على هذا التوضيح رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 هذا ملف اخر لا يأخذ بعين الاعتبار ما تحتويه الخلايا (فقط ينظر الى الارقام بين 1 و نهاية الشهر) ولا ينظر الى الفواصل اي كانت (فواصل نص * \ / الخ.....) Option Explicit Sub Saerch_date() Dim regex As Object, str As String Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .IgnoreCase = True .Pattern = "([1-3]?\d+)" End With Dim MY_Match, x%, s$, i%, m%: m = 1 Dim Days_num$, Final_Month% Dim my_array() Dim arr_arab(1 To 7) arr_arab(1) = "الأحد": arr_arab(2) = "الإثنين" arr_arab(3) = "الثلاثاء": arr_arab(4) = "الأربعاء" arr_arab(5) = "الخميس": arr_arab(6) = "الجمعة" arr_arab(7) = "السّبت" Range("E5:E16,G5:G16").ClearContents For i = 5 To 16 Set MY_Match = regex.Execute(Range("c" & i)) If MY_Match.Count = 0 Then GoTo next_i For x = MY_Match.Count - 1 To 0 Step -1 Final_Month = Month(DateSerial([E2], i - 4, MY_Match(x))) If Final_Month = i - 4 Then Days_num = Weekday(DateSerial([E2], i - 4, MY_Match(x))) ReDim Preserve my_array(1 To m) my_array(m) = arr_arab(Days_num) m = m + 1 End If Next x Range("E" & i) = m - 1 s = Join(my_array, ",") Range("G" & i) = s s = "": m = 1: Erase my_array next_i: Next Set regex = Nothing Erase arr_arab End Sub الملف مرفق khairi ali_Extra.xlsm 2 رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر أبريل 19, 2019 الكاتب مشاركة قام بنشر أبريل 19, 2019 السلام عليكم ورحمة الله وبركاته اشكر كل من ساهم في المرور على هذا الموضوع قدم المساعدة لدي سؤال اخر وهو حساب تكرر أيام الغياب ولكم مني جزيل الشكر والتقدير حساب تكرر أيام الغياب.xlsm 1 رابط هذا التعليق شارك More sharing options...
احمد بدره قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 بارك الله فيك أستاذنا الفاضل والمبدع دائمًا نتعلم من الكثير عمل في غاية الروعة 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 في الخلية I5 هذه المعادلة ( Ctrl+Shift+Enter) =SUM(--(ISNUMBER(FIND(I$3,$G$5:$G$16)))) tekrar 8yab.xlsm 1 رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر أبريل 19, 2019 الكاتب مشاركة قام بنشر أبريل 19, 2019 مشكور جدا أخي سليم لو سمحت حساب التكرر لكل شهر على حده رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 تم معالجة الأمر tekrar 8yab _Month.xlsm رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر أبريل 19, 2019 الكاتب مشاركة قام بنشر أبريل 19, 2019 بارك الله فيك أستاذ سليم رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 مزيد المزيد في هذا الملف مع الشرح الوافي UDF_tekrar 8yab .xlsm 1 1 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر أبريل 19, 2019 مشاركة قام بنشر أبريل 19, 2019 الى استاذنا الحبيب الاستاذ سليم شكر لك على النصائح التى توجها لنا وبارك الله فيكم وفى علمكم عمل فى غاية الجمال والروعة جزاكم الله خير 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان