تصفية متقدمة بين تاريخين وفق عدة معايير بالأكواد والمعادلات للتاريخ

[محمد حسن المحمد]

بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه أما بعد:

السلام عليكم ورحمة الله وبركاته ...إخوتي الكرام

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

تصفية متقدمة بين تاريخين وفق عدة معايير  ..بالكود حيث بإمكانك تحديد تاريخي البدء والانتهاء ..وأيضاً المعايير للتتغير تلقائياً وفق الكود في حدث الورقة كما يلي:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range(" l4:p4")) Is Nothing Then
        Call تصفية_متقدمة
    End If
End Sub

أما الكود الأساسي للتصفية المتقدمة فهو في حدث موديول وفق الآتي:

Sub تصفية_متقدمة()
' مفتاح الاختصار: Ctrl+Shift+S
    ورقة1.Range("B9").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "متقدمة!Criteria"), CopyToRange:=Range("متقدمة!Extract"), Unique:=False
End Sub

هذا من ناحية الأكواد ،أما المعادلات ضمن معادلة صفيف Ctrl+Shift+Enter

يقوم بالتصفية حسب التاريخ:

=IFERROR(INDEX(B$10:B$25;SMALL(IF(($C$3<$B$10:$B25)*($C$4>=$B$10:$B25);ROW($B$10:$B25)-9);ROW(A1)));"")

أرجو أن تكون به فائدة ومن كان لديه ما يثري الموضوع فليتحفنا بمشاركته مشكوراً ...لأنني أحب التعلم وإن لم أستطع إدراك الكثير والحمد لله على ما يسّر الله لنا 

والصلاة والسلام على سيد المرسلين والحمد لله رب العالمين ...والسلام عليكم.

حمل الملف من هنا

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

بسم الله ما شاء الله

ملف رائع وممتاز .. ومش بس بالمعادلات لا وبالأكواد كمان ..

جزاكم الله خيراً أخي الحبيب ابو يوسف ومشكور على الموضوع الرائع والممتع

واصل بلا فوااااااااااااااااااصل .. هكذا نريد الجميع أن يقدموا ما تعلموه بأسلوبهم

تقبل وافر تقديري واحترامي

 

[محمد حسن المحمد]

15 دقائق مضت, ياسر خليل أبو البراء said:

بسم الله ما شاء الله

ملف رائع وممتاز .. ومش بس بالمعادلات لا وبالأكواد كمان ..

جزاكم الله خيراً أخي الحبيب ابو يوسف ومشكور على الموضوع الرائع والممتع

واصل بلا فوااااااااااااااااااصل .. هكذا نريد الجميع أن يقدموا ما تعلموه بأسلوبهم

تقبل وافر تقديري واحترامي

 

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

فالمعلم الناجح دائماً يسعى نحو رفع مستوى تلامذته يسبر معلوماتهم يتابعهم يدقق ويصحح ويحفز ويشجع

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

 والسلام عليكم

 

تم تعديل مارس 30, 2016 بواسطه محمد حسن المحمد

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

وعليكم السلام ورحمة الله وبركاته أبي الحبيب أبو يوسف

الحمد لله الذي هداك للتعلم وتعلي إخوانك .. بارك الله فيك وجزاك الله كل خير

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

Sub DataBetweenTwoDates()
    Dim Arr, Temp, I As Long, P As Long, startDate As Date, endDate As Date
    
    Arr = Range("B9").CurrentRegion.Offset(1).Value
    startDate = Range("C3").Value2: endDate = Range("C4").Value2
    ReDim Temp(UBound(Arr, 1) - 1, UBound(Arr, 2) - 1)
    
    For I = LBound(Arr, 1) To UBound(Arr, 1)
        If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then
            Temp(P, 0) = Arr(I, 1)
            Temp(P, 1) = Arr(I, 2)
            Temp(P, 2) = Arr(I, 3)
            Temp(P, 3) = Arr(I, 4)
            P = P + 1
        End If
    Next I
    
    Range("L10").Resize(UBound(Temp, 1), UBound(Temp, 2) + 1).Value = Temp
End Sub

 

[محمد حسن المحمد]

السلام عليكم ورحمة الله وبركاته ..أخي الحبيب أبو البراء...

كود رائع قمت بوضعه بدلاً من الكود السابق .. أدى العمل المطلوب" وفق التاريخ"بشكل صحيح..

جزاكم الله خيراً ونفع بعلمكم...آمين...بارك الله.

[أبوبسمله]

جزاك الله خيرا ابانا الغالى ابويوسف

ونقول نعم المعلم والمتعلم 

جزاك الله كل خير ياابوالبراء على ماتيسره لنا من معلومات نتعلم ونستفيد منها

وجزا الله جميع اخواننا الافاضل اللذين لم يبخلوا علينا بما فضلهم الله من علم 

تقبلوا منى فائق التحيه والاحترام والتقدير

[محمد حسن المحمد]

السلام عليكم أخي الحبيب أبو بسملة 

جزاكم الله خيرا على كلماتكم العطرة ومروركم الكريم الذي شرفتمونا به.

كلماتكم الطيبة حافز لنا للمضي قدما ...بحثا ودرسا 

وتنقيبا عن الدرر المكنونة في أمهات الكتب " google"التي جمعت بين طياتها كل علوم وآداب وسير البشرية...والسلام عليكم.

[ياسر العربى]

بارك الله فيك اخي الكريم

ابو يوسف

الله ينور يامعلم ايه الحلاوة دي

وزي ما قال ابو البراء كلٍ يدلو بدلوه  الا ياسر عشان دلوه فاضي

وان شاء الله الجردل بتاعك يا ابو يوسف مليان يلا غرقنا بقي

تقبل تحياتي

[محمد حسن المحمد]

السلام عليكم ورحمة الله وبركاته حبيبي الغالي أبو أسيل مروركم شرفني..ما أنا إلا تلميذ بمدرستكم وخير شاهد أكواد الآلة الحاسبة"فيجوال بيزك 2012 ".

أرجو الله أن يبقيكم ذخرا لنا والسلام عليكم.

[saad abed]

اخى العزيز جدا محمد حسن ابويوسف

ابداع في المعادلات والاكواد

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

اخى ابو البراء

انت معلمنا جزاك الله خيرا

5 ساعات مضت, ياسر خليل أبو البراء said:

 

Sub DataBetweenTwoDates()
    Dim Arr, Temp, I As Long, P As Long, startDate As Date, endDate As Date
    
    Arr = Range("B9").CurrentRegion.Offset(1).Value
    startDate = Range("C3").Value2: endDate = Range("C4").Value2
    ReDim Temp(UBound(Arr, 1) - 1, UBound(Arr, 2) - 1)
    
    For I = LBound(Arr, 1) To UBound(Arr, 1)
        If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then
            Temp(P, 0) = Arr(I, 1)
            Temp(P, 1) = Arr(I, 2)
            Temp(P, 2) = Arr(I, 3)
            Temp(P, 3) = Arr(I, 4)
            P = P + 1
        End If
    Next I
    
    Range("L10").Resize(UBound(Temp, 1), UBound(Temp, 2) + 1).Value = Temp
End Sub

 

ا

 

اخى ياسر

ما الفرق بين valueوvalue2

ما فائدة redimفى الكود

شرح بسيط لفكرة والية عمل الكود

ماذا افعل لاضافة شرطين

اسال كتيره

[محمد حسن المحمد]

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

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

1- Value: قيمة تاريخ البدء.

2- Value2:قيمة تاريخ الانتهاء.

3- ReDim:إعادة الحلقة التكرارية من جديد( وهذه لست متأكدا منها)..نرجو التدقيق في هذه الإجابات لننطلق منها.

والسلام عليكم ورحمة الله وبركاته.

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

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

 

أخي الغالي سعد عابد

أسئلة كثيرة .................. ولكن لعيون سعد (سعد سعد يحيا سعد)

الفرق بين Value و Value2 لن أجيبك بشكل نظري بحت ولكن اعلم أن التاريخ يكتب في خلية ويظهر لك بشكل مختلف عن الشكل الأصلي الذي يقرأه الإكسيل

اكتب أي تاريخ في الخلية A1 ....

روح لمحرر الأكواد واضغط Ctrl + G عشان تفتح النافذة الفورية (يوجد موضوع لها في حلقات افتح الباب) ...

في النافذة الفورية اكتب هذين السطرين (أنا قلت اكتب ولم أقل انسخ والصق ..بطل كسل)

?range("A1").Value

?range("A1").Value2

ولاحظ النتائج بنفسك

السؤال الثاني هو الكلمة Redim وهي لإعادة تشكيل المصفوفة من حيث الأبعاد فوضعت هنا لكي أجعلها نفس أبعاد المصفوفة الأولى المسماة Arr ..

السؤال الثالث لإضافة شروط .... الموضوع بسيط

شايف السطر ده اللي فيه IF .....

If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then

قبل كلمة Then يمكن إضافة الشروط باستخدام كلمة AND ثم تضيف الشرط المطلوب .. ويمكن إضافة أكثر من شرط لا مشكلة في ذلك على الإطلاق

 

أما بخصوص آلية الكود فهو يقوم بوضع قيم النطاق في مصفوفة ثم إنشاء مصفوفة أخرى لوضع النتائج المتوافقة مع الشروط الموضوعة وفي نهاية المطاف في آخر سطر يتم التعامل مع الإكسيل بوضع النتائج التي في المصفوفة Temp ووضعها في الخلية L10

 

أرجو أن تكون الإجابات قد أدت الغرض

وأخيراً إليك شرح الكود في الموديول الثاني في الملف المرفق

 

حمل الملف من هنا

 

وتقبلوا وافر تقديري واحترامي

[saad abed]

اخى ابوالبراء

تسلم اخى اسال الله ان يمد في عمرك وان يحسن عملك

جزاكم الله خير

[محمد حسن المحمد]

السلام عليكم ورحمة الله وبركاته

صورة توضح ربط التاريخين في ال Criteria بجدول تاريخي البدء والانتهاء ولذلك لا حاجة للكتابة بهما...تم إخفاؤهما..والدالة هي:

=IF(C3="";"";">="&C3)
=IF(C4="";"";"<="&C4)
  

كما تم إعداد قوائم منسدلة لخلايا ال Criteria الباقية باستخدام التسمية للقوائم باستخدام المعادلة التالية:

=OFFSET(متقدمة!$C$10;;;COUNTA(متقدمة!$C$10:$C$100))

وذلك كمتمم للتصفية المتقدمة لتلبي حاجتنا بشكل أسرع 

والسلام عليكم ورحمة الله وبركاته.

[جلال الجمال_ابو أدهم]

جزاك الله خيرا و جعله الله فى ميزان حساناتك

[محمد حسن المحمد]

السلام عليكم ورحمة الله وبركاته:

تشرفت بمروركم العطر أخي الكريم جلال الجمال_ابو أدهم 

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

والسلام عليكم ورحمة الله وبركاته

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

كفيت و وفّيت يا "أبا يوسف" ..

بارك الله فيك و لك ..

بارك الله بصحّتك و أوقاتك و أعمالك و بجميع أفراد أسرتك الكريمة ..

مواضيعك .. بل دروسك و أعمالك ممتازة و مميّزة و أكثر من ذلك ..راقية و متقنة ..

نستفيد كلّنا منه كمرجع من المرجعيات لكل من يهتم بالحسابات و الفواتير

جزاك الله خير الجزاء و زادك من علمه و فضله

فائق إحتراماتي و إعجاباتي

 

[محمد حسن المحمد]

1 دقيقه مضت, عبد العزيز البسكري said:

السّلام عليكم و رحمة الله و بركاته

كفيت و وفّيت يا "أبا يوسف" ..

بارك الله فيك و لك ..

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

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

والسلام عليكم ورحمة الله وبركاته.

أخي الحبيب " أحمد الفلاحجي أبو بسملة" جعلك الله من أهل الحمد ...آمين

 ...أشكركم على هذا الدعم اللا محدود .

جعله الله بميزان حسناتكم والسلام عليكم ورحمة الله وبركاته.

[الصـقر]

استاذى الحبيب / ابويوسف

جزاكم الله خيرا ونفع بكم

الى الامام دائما وننتظر ابداع جديد 

تقبل تحياتى

 

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

أخي الغالي " محمّد حسن المحمّد "

لا أفهم بمواضيع الحسابات و المخازن .. لكن أردت المشاركة بالموضوع .. فكانت هديّتي بالملف المرفق ..

فائق إحتراماتي

 

تصفية متقدمة لعدة معايير بين تاريخين.rar

تم تعديل أبريل 3, 2016 بواسطه عبد العزيز البسكري

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

أخي الحبيب عبد العزيز

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

تقبل تحياتي

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

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

أشكر مرورك العطر .. قد تم التّعديل بإذن الله

خالص إحتراماتي

 

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

هدية جميلة ورائعة من أخ رائع ومتميز

بارك الله فيك أخي الحبيب عبد العزيز .. متمكن في التعامل مع الفورم

جزيت خيراً وجعل الله أعمالك في ميزان حسناتك يوم القيامة

[محمد حسن المحمد]

13 ساعات مضت, عبد العزيز البسكري said:

السّلام عليكم و رحمة الله و بركاته

أخي الغالي " محمّد حسن المحمّد "

لا أفهم بمواضيع الحسابات و المخازن .. لكن أردت المشاركة بالموضوع .. فكانت هديّتي بالملف المرفق ..

فائق إحتراماتي

 

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

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

والسلام عليكم