ياسر خليل أبو البراء

أخي الكريم أبو عيد .. لم أفهم طريقة حل المشكلة التي أرفقتها في الملف في العمودين Q و R ما الفائدة من طريقة الحل تلك؟ !!

أخي الكريم أحمد أقصد باللغة العربية هو اسمك Ahmede أن يكون باللغة العربية (ويفضل اسم ولقب) المهم راجع موضوع التوجيهات وستعرف كيف يمكنك ذلك .. يبدو أنني نسيت إرفاق الملف لك في مشاركتي السابقة ..اطلع على الملف المرفق وأبدي ملاحظاتك عليه ... وضع المعادلات و الأكواد داخل أقواس الكود لتظهر بشكل صحيح في المشاركات أو ارفق الملف مرة أخرى موضحاً الخلايا التي توضع فيها المعطيات والنتائج المتوقعة Sample.rar

أخي الكريم خالد ... حدد مشكلة واحدة للعمل عليها وليكن حديثك مفصلاً لا عاماً أقصد تحدث بلغة الإكسيل ..أي تقول في ورقة العمل كذا في النطاق كذا يحدث كذا والمتوقع أن تكون النتيجة كذا ... هكذا أفضل للجميع وأوضح اطلعت على الملف وصراحة وجدته ثقيلاً جداً في التعامل معه ، يبدو أنك تكثر من معادلات الصفيف ..إن شاء الله يمكنك طرح موضوعات لحل مشكلة ملفك واستبدال المعادلات بأكواد فهذا أيسر وأخف وأفضل بكثير في انتظار تفصيلك المفصل التفصيلي .. ووضح لو لزم الأمر بالصور تقبل تحياتي

نعم أخي ولكني اطلعت على ملفك ويعمل بشكل جيد ربما لم ألتفت جيداً للمشكلة لذا طلبت موضع المشكلة بالضبط من خلال المثال المرفق وضح المشكلة بالصور لكي أعاينها وأعاين المشكلة إن شاء الله يمكن إضافة السطر التالي في بداية عمل الدالة المعرفة لتخطي المشكلة Application.Volatile قد تكون المشكلة في تلك النقطة

أخي الكريم موريادي قمت بعمل أعمدة مساعدة في الورقة المسماة Report عمود لإدراج الشهور الهجرية فيه .. وعمود لإدراج السنوات .. وفي الخلية I1 معادلة لمعرفة رقم الشهر الهجري ومقارنته أثناء عمل الكود تقوم بالاختيار من القائمة المنسدلة الشهر المطلوب وليكن "شعبان" ثم تختار السنة الهجرية من الخلية المجاورة F2 .. ثم أخيراً انقر على زر الأمر لجلب البيانات من ورقة العمل Data تم استخدام المصفوفات في الأكواد لسرعتها في التعامل مع البيانات الكبيرة Sub Test() 'Author : YasserKhalil 'Release : 29 - 08 - 2016 '------------------------ Dim Ws As Worksheet, Sh As Worksheet Dim Arr, Temp Dim Lr As Long, I As Long, P As Long Dim lMonth As Integer, lYear As Integer Set Ws = Sheets("Data"): Set Sh = Sheets("Report") Lr = WorksheetFunction.CountA(Ws.Columns(2)) lMonth = Sh.Range("I1").Value lYear = Sh.Range("F2").Value Arr = Ws.Range("A2:H" & Lr).Value ReDim Temp(1 To UBound(Arr, 1), 1 To 3) For I = 1 To UBound(Arr, 1) If Month(DHijri(CDate(Arr(I, 5)))) = lMonth And Year(DHijri(CDate(Arr(I, 5)))) = lYear Then Temp(P + 1, 1) = Arr(I, 4) Temp(P + 1, 2) = Arr(I, 5) Temp(P + 1, 3) = Arr(I, 8) P = P + 1 End If Next I Sh.Range("A6:C10000").ClearContents If P > 0 Then Sh.Range("A6").Resize(P, UBound(Temp, 2)).Value = Temp MsgBox "Done...", 64 Else MsgBox "No Data For This Month And This Year", vbExclamation End If End Sub Function DHijri(dtGegDate As Date) As String VBA.Calendar = vbCalHijri DHijri = dtGegDate VBA.Calendar = vbCalGreg End Function أرجو أن يفي هذا بالغرض إن شاء الله تقبل تحياتي Grab Data By Hijri Dates Using Arrays YasserKhalil.rar

أخي الكريم قم بضغط ملفك وارفعه على موقع خارجي وكيف حاولت أن تقوم بتعديله ؟؟ بأي لغة برمجة؟ صحيح أنه في كثير من الأحيان تقابلنا مشاكل جديدة ولا نعلم كيفية حلها ..لكن بالصبر والمثابرة والمحاولة والتعاون نجد الحلول بإذن الله

شاهد الفيديو التالي عله يفي بالغرض إن شاء الله 2016-08-29_14-43-46.rar

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

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

الحمد لله أن تم المطلوب على خير وأنك تعلمت شيئاً جديداً .. فلربما في يوم من الأيام سأل سائل أو وقع أحدهم في نفس مشكلتك .. ساعتها ستسطيع أن تجيبه مسألته ولا تنسى أنني قد ألح عليك في أن تقوم بالعمل بنفسك لتتعلم .. فلن تتعلم أبداً طالما تأخذ وفقط .. لابد من العطاء لتستمر المسيرة تقبل تحياتي

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

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

من أي خلية تقوم بتحديد الشهر المطلوب؟ وهل البيانات في الورقة Data ستكون جامعة لعدة شهور أرجو وضع بيانات كافية لتوضيح المطلوب وللعمل على الملف ولتجربة الأكواد عليه

هذا ما أخبرتك به أن الطلب غير واضح من البداية وقد عملت على تخمين (رغم أنني لا أحب العمل على التخمينات) عموماً حاول توضح أكثر المشكلة بالصور وشكل النتائج المتوقعة حيث أنني لا أفهم لغة (السند - الايصال - الوكيل - ...) وضح شكل الورقة المتوقعة .. أعتقد المشكلة تكمن في تصميم ورقة العمل ولا علاقة للأكواد بهذا الأمر في هذه الحالة إلا إذا كانت هناك خلايا معينة يتم وضع قيم فيها عن طريق الأكواد

أخي الكريم الشيباني جرب الكود التالي للترحيل إلى ورقة العمل المسماة Out .. أما بالنسبة للترحيل إلى ورقة العمل In فيحتاج لتفصيل أكثر وهل عدد الأسماء ثابتة ؟وأين بقية التفاصيل ؟ وهل هي ثابتة ؟ ...!! Sub Test() Dim Ws As Worksheet, shOut As Worksheet, shIn As Worksheet Dim Lr1 As Long, Lr2 As Long, Lr3 As Long, lastOut As Long, lastIn As Long Dim I As Long, II As Long Set Ws = Sheet1: Set shOut = Sheet2: Set shIn = Sheet3 Lr1 = Ws.Range("C9").End(xlDown).Row Lr2 = Ws.Range("C22").End(xlDown).Row Lr3 = Ws.Range("C36").End(xlDown).Row lastOut = shOut.Cells(Rows.Count, "D").End(xlUp).Row + 1 lastIn = shIn.Cells(Rows.Count, "B").End(xlUp).Row + 1 Application.ScreenUpdating = False If Lr1 = 18 Then GoTo Skipper1 For I = 10 To Lr1 shOut.Range("B" & lastOut).Value = Ws.Cells(3, "J").Value shOut.Range("D" & lastOut + II).Value = Ws.Cells(I, "C").Value shOut.Range("E" & lastOut + II).Value = Ws.Cells(I, "E").Value II = II + 1 Next I shOut.Range("G" & lastOut).Value = Application.WorksheetFunction.Sum(shOut.Range("D" & lastOut & ":D" & lastOut + II - 1)) Skipper1: If Lr2 = 32 Then GoTo Skipper2 II = 0 For I = 23 To Lr2 shOut.Range("I" & lastOut + II).Value = Ws.Cells(I, "C").Value shOut.Range("J" & lastOut + II).Value = Ws.Cells(I, "E").Value II = II + 1 Next I shOut.Range("L" & lastOut).Value = Application.WorksheetFunction.Sum(shOut.Range("I" & lastOut & ":I" & lastOut + II - 1)) Skipper2: If Lr3 = 43 Then GoTo Skipper3 II = 0 For I = 37 To Lr3 shOut.Range("N" & lastOut + II).Value = Ws.Cells(I, "C").Value shOut.Range("O" & lastOut + II).Value = Ws.Cells(I, "E").Value II = II + 1 Next I shOut.Range("Q" & lastOut).Value = Application.WorksheetFunction.Sum(shOut.Range("N" & lastOut & ":N" & lastOut + II - 1)) Skipper3: shOut.Range("S" & lastOut).Value = Ws.Cells(45, "E").Value shOut.Range("U" & lastOut).Value = Ws.Cells(49, "C").Value Application.ScreenUpdating = True End Sub أرجو أن يفي هذا بالغرض

الحمد لله أن تم المطلوب على خير .. لاحظت شيء أثناء عملي بالملف بالنسبة لإجمالي عدد الساعات سيظهر بشكل خاطيء في عمود ساعات العمل ..لذا قم بتنسيق النطاق E38:G38 بتنسيق مخصص [hh]:mm ليظهر لك عدد الساعات بشكل منضبط .. أرجو أن يفي هذا بالغرض وأن تكون الأمور على ما يرام وفقك الله لما يحب ويرضى تقبل تحياتي

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

ردك غريب وكأنك ترد الباب في وجهي وتقول "مش عايز منك مساعدة" !! أرجو أن يكون ظني في غير محله .. لم تفدنا هل أدى المطلوب الغرض أم لا .. بارك الله فيك أخي العزيز .. الكل يشارك وأنا لست بمفتي المدينة إنما طالب علم مثلي مثلكم ، والمناقشات تثري الموضوعات وتفيد الجميع أرجو أن تغير اسم الظهور للغة العربية ، فأنت عضو قديم في المنتدى ولك صولات وجولات في موضوعات كثيرة

أخي الكريم صلاح مش عارف تقول ايه وقلت "جزاك الله خيراً" كدا إنت قلت أهو .. لو اطلعت على الموضوع في الرابط في أول مرة كان هيفيدك في الحل .. بس أعمل ايه مفيش كلام بيتسمع ولا أقولك بلاش لو عشان دي بتفتح أبواب الشيطان . نقول " قدر الله وما شاء فعل ، ولعله خير .. تقبل تحياتي

المشكلة إن الوقت لا يقبل أن يكون بالسالب .. أقترح أن تقوم بإضافة عمود جديد وتسيمه "عمود التأخير" على غرار عمود "ساعات الإضافي" ووتقوم بوضع المعادلة التالية .. بفرض أن العمود الجديد سيكون محل عمود الملاحظات ، في الخلية G7 ضع المعادلة التالية =IF(E7<$A$5,$A$5-E7,"") وبذلك تحصل على وقت التأخير بالموجب وبدون مشاكل .. أرجو أن يفي هذا بالغرض

أخي الكريم اقرأ المشاركة مرة أخرى .. لاحظ أنني قلت أن الكود متشابك ووجهتك لآخر إجراء موجود باسم Print_All ستجده في نهاية الكود الخاص بالفورم راجع المشاركة مرة أخرى الأخ الكريم راسبوتين قمت بذكر كلمة المرور للملف في مشاركتي السابقة

جرب الكود التالي عله يفي بالغرض Sub Test() Dim Ws As Worksheet, Sh As Worksheet Dim Rng As Range, Lr As Long, Last As Long Set Ws = Sheets("Data"): Set Sh = Sheets("Report") Lr = WorksheetFunction.CountA(Ws.Columns(2)) Last = Sh.Cells(Rows.Count, "A").End(xlUp).Row + 1 Application.ScreenUpdating = False Set Rng = Union(Ws.Range("D2:E" & Lr), Ws.Range("H2:H" & Lr)) Rng.Copy Sh.Range("A" & Last).PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

أكرر أخي الكريم ضع بعض البيانات في الورقة Data .. مع وضع مثال لنتيجة متوقعة في الورقة Report الأمر ملتبس عليا في نقطة واحدة الآن : قلت في مشاركتك الأصلية أنك تريد إنشاء ورقة عمل جديدة لعمل التقرير ، والآن تقول أن الشيت Report هو الشكل الذي أريده أي أن الورقة موجودة .. حدد بالضبط هل ورقة العمل Report موجودة أم أنك تريد إنشاء ورقة عمل جديدة مثلها ، وفي تلك الحالة ما هي مواصفات ورقة العمل ما اسمها مثلاً (الورقة الجديدة المضافة) أم أن العمل مجرد ترحيل للبيانات من ورقة Data إلى ورقة Report لخلايا محددة ... وأكرر في هذه الحالة نريد بعض النتائج المتوقعة حيث أن البيانات غير واضحة المعالم أعتذر عن الإلحاح في توضيح الأمر ، لكن لابد لحل أي مشكلة أن تكون الأمور واضحة وضوح الشمس في كبد السماء لم أرى مشاركتك إلا الآن ..يبدو أنك قمت بالمشاركة أثناء كتابة الرد من قبلي ..سأقوم بالإطلاع على المرفق وموافاتك بالنتيجة إن أمكن ..

أخي الكريم أحمد بن إبراهيم لما التواصل بشكل خاص ؟!! .. الأفضل أن يكون التواصل بشكل عام ليستفيد الجميع لا خاص في المنتدى (راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى) اقتراحي لك أن تطرح موضوع جديد حيث أن الموضوع الذي فيه مشاركات كثيرة لا يلتفت إليه في كثير من الأحيان .. ارفق الملف الذي تعمل عليه ، ووضح المشكلة التي تظهر معك لتجد استجابة أفضل تقبل تحياتي

ارجع للملف الخاص بأخونا ياسر الشيخ لأني اشتغلت عليه .. حمل الملف واجعل الحساب أوتوماتيك Automatic كما بينت في المشاركة السابقة قم بالتالي .. 1- غير التنسيق للنطاقات التالية ليكون hh:mm >>> الخلية A5 ، والنطاق E7:F38 ، والنطاق H2:H3 2 - اكتب القيمة 08:00 في الخلية A5 مرة أخرى حيث الموجود غير صحيح (وإن كان الظاهر صحيح) 3 - ضع المعادلة التالية (معادلة عادية جداً لطرح الانصراف - الحضور) في الخلية E7 =D7-C7 4 - ضع المعادلة التالية في الخلية F7 لحساب الإضافي (في حالة السالب جعلت الخلية فارغة) =IF(E7>$A$5,E7-$A$5,"") 5 - قم بسحب المعادلة في النقطة رقم 4 والنقطة رقم 5 إلى الصف رقم 37 6- ضع المعادلة التالية في الخلية I2 =(HOUR(H2)+MINUTE(H2)/60+SECOND(H2)/3600)*$A$3 ثم اسحبها للخلية I3 إذا كانت هناك مشكلة في المعادلات استبدل الفاصلة العادية بفاصلة منقوطة أرجو أن يفي هذا بالغرض تقبل تحياتي