ياسر العربى

اخي الكريم جمال مشكور على مرورك الكريم اما بالنسبة لطلبك كل ما عليك تعديله في الكود هو السطرالتالي If myArray(X, targtN) Like targt & "*" Then يتم تغيير الى If myArray(X, targtN) Like "*" & targt & "*" Then

دا مثال بسيط لتشغيل الفيديو داخل ملف الاكسيل كل ما عليك هو تغيير مسار الفيديو لملف فيديو موجود على جهاز Video.rar

قمت بربط كود تطبيق الوارد اولا صادر اولا على ملف الاخ الفرس في شيت مستقل ويتم التنقل بين الاصناف عن طريق قائمة منسدلة يختار منها الكود مراقبة المخزون.rar

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

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

تفضل بس الملف كدا فيه ارقام كتير متشابهه عشان كدا هتلاقي الوان تراكمت فوق بعض صغر نطاق الارقام وانت تتأكد من عمل الملف YASSER.rar

حبيبي ابو البراء معلش بقى مكان ما تحط تشفيرك احط تشفيري تفضلو تشفير كل انواع الملفات ولا يستطيع احد فتحها من الخارج http://yasserelaraby86.blogspot.com.eg/2016/04/blog-post_24.html تقبل تحياتي

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

جزيت خيرا اخي الغالي ابو البراء على الشرح الوافي تقبل تحياتي

تفضل Yasser_project1.rar

تفضل اخي الكريم طلبك Serch_Yasser.rar

اخي الكريم ناصر يرجى ارفاق المثال للتوضيح وشكرا

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

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

مشكورين جميعا اخواني لمروركم الكريم تقبلو خالص تحياتي اما بخصوص البحث بشروط تفضلو التعديل بحث باي شرط الى شرط التاريخ كما طلب الاخ عاطف وشكرا SERCH_ARRY_YASSER_ELARABY1.rar

مشكور استاذنا / بن عليه واليكم الملف باي شرط مع شرط التاريخ تقبلو تحياتي SERCH_ARRY_YASSER_ELARABY1.rar

بسم الله الرحمن الرحيم اقدم لكم كود بحث متقدم كود بحث متقدم يفوق معظم أنواع البحث بالاعتماد على المصفوفات لضمان كفاءة عالية للبحث وسرعة جلب البيانات والمرونة العالية به من حيث البحث داخل كل الأعمدة الموجودة داخل النطاق تم توضيح المتغيرات التي تستطيعوا تعديلها لتتوافق مع ملفاتكم الكود المستخدم داخل الملف Sub Yasser_Serch() Dim myArray, lr, X, targt, targtN Dim SERCH As Worksheet, DATA As Worksheet '____________________________________________ Set DATA = Worksheets("Sheet2") 'اسم شيت قاعدة البيانات Set SERCH = Worksheets("Sheet1") 'اسم الشيت الخاص بالبحث '____________________________________________ lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row 'اخر صف به بيانات SERCH.Range("A4:J" & SERCH.Cells(Rows.Count, 4).End(xlUp).Row + 1).ClearContents 'مسح نطاق البحث القديم targt = SERCH.Range("e1").Value 'خلية البحث targtN = Application.WorksheetFunction.Match(SERCH.Range("D1"), SERCH.Range("A3:J3"), 0) 'دالة لايجاد رقم عمود البحث myArray = DATA.Range("A2:J" & lr + 1) 'نطاق قاعدةالبيانات الذي سيتم البحث فيه '____________________________________________ ReDim Y(1 To lr, 1 To 10) For X = 1 To lr If targt = "" Then Exit Sub If myArray(X, targtN) Like targt & "*" Then rw = rw + 1 Y(rw, 1) = myArray(X, 1): Y(rw, 6) = myArray(X, 6) Y(rw, 2) = myArray(X, 2): Y(rw, 7) = myArray(X, 7) Y(rw, 3) = myArray(X, 3): Y(rw, 8) = myArray(X, 8) Y(rw, 4) = myArray(X, 4): Y(rw, 9) = myArray(X, 9) Y(rw, 5) = myArray(X, 5): Y(rw, 10) = myArray(X, 10) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(rw, 10).Value = Y() End Sub لتحميل الملف اضغط هنا اعداد / ياسر العربي تقبلو تحياتي

206 عدد الطلاب الموجودة بالكشف يعني لو عدد الطلاب اصبح 350 طالب نكتب مكان ال206 نكتب 350 ولكن رأيت ان من الافضل ان تكون صفحة بيانات المدرسة هي الاساس في بعض البيانات وتم التعديل قليلا ليتم الاعتماد على عدد الطلاب من صفحة بيانات المدرسة كما بالمرفق استخراج حالة الطالب ومواد الرسوب معدل YASSER.rar

تعديل بسيط بالكود ليتماشى مع نظام المدارس اكثر Sub YASSER_ELARABY() 'YASSER_ELARABY Dim ARR Dim ARRY Dim ARRYS '___________________________________________ Dim R As Long Dim X As Long Dim XX As Byte Dim ALL_LESS As String '___________________________________________ Const STATUS As Byte = 101 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 102 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 112 ' عمود الجنس ذكر او انثى '_____________________________________________________ Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 7 ' اول صف لاسماء الطلاب Const NAME_LAST As Long = 206 + NAME_FIRST ' عدد الطلاب '_____________________________________________________ ARR = Array(9, 18, 27, 36, 46, 52, 54, 59, 64, 69, 78) ' اعمدة اختبار الفصل الدارسي الثاني لجميع المواد ARRY = Array(13, 22, 31, 40, 51, 52, 57, 62, 67, 72, 82) 'اعمدة الدرجة النهائية لجميع المواد ARRYS = Array(5, 14, 23, 32, 41, 52, 53, 58, 63, 68, 74) 'اعمدة اسماء كل المواد '_____________________________________________________ With Sheet2 'اسم شيت البيانات Application.ScreenUpdating = False 'الغاء تحديث الشاشة Application.Calculation = xlManual ' ايقاف الحساب التلقائي For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next '____________________________________________________ 'يتم حساب عدد ا لمواد المتغيب بها الطالب او درجتها صفر ويتم وضع عدد المواد في المتغير اكس اكس 'اذا وصل عدد المواد الى 11 اصبح الطالب متغيب If .Cells(R, ARRY(X)) = 0 Or .Cells(R, ARRY(X)) = "غ" Then XX = XX + 1 End If '____________________________________________________ 'هذا الجزء خاص بمادة العلوم تحديدا الفصل الدراسي الثاني لانه مقسم على عمودين فتم اضافة هذا الجزء ليتم معالجة هذه المرحلة If ARR(X) = 46 Then 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If Val(.Cells(R, ARR(X))) + Val(.Cells(R, ARR(X) + 1)) < Val(.Cells(LESS_ROW, ARR(X))) Or .Cells(R, ARR(X)) = "غ" Or .Cells(R, ARR(X) + 1) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 GoTo 86 'هنا يتم تخطى عمل الكود بالاسفل حتى لايتم معالجة مادة العلوم مرة اخرى Else GoTo 86 'وهنا ايضا يتم تخطى مادة العلوم الى المادة الاخرى End If End If 'هنا يتم مقارنة المواد بالدرجة الصغرى الخاصة الفصل الدارسي الثاني في اول الكود او اذا كانت غياب يتم اضافة اسم المادة من صف المواد الى المتغير 'ALL_LESS 'او مقارنة الدرجة النهائية لكل مادة بالدرجة الصغرى لها او اذا كانت غياب اذا تحقق الشرط فيتم اضافة المادة الى المتغير 'ALL_LESS '______________________________________________________ If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 End If If .Cells(R, ARRY(X)) < .Cells(LESS_ROW, ARRY(X)) Or .Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " End If '______________________________________________________ 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد 'اذا كان المتغير اكس اكس بيساوي عدد المواد اذن الطالب متغيب If XX = 11 Then ALL_LESS = "غياب ": XX = 0 '_____________________________________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = 1 Then .Cells(R, STATUS) = "ناجح " 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = 2 Then .Cells(R, STATUS) = "ناجحة " 'اذا كانت انثى يتم وضع ناجحه If .Cells(R, GENDER) = 1 Then .Cells(R, NOTES) = "ومنقول " & INFO.Range("B14") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = 2 Then .Cells(R, NOTES) = "ومنقولة " & INFO.Range("B14") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = 1 Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = 2 Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If '_____________________________________________________ Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True 'اعادة تحديث الشاشة Application.Calculation = xlAutomatic 'تشغيل الحساب التلقائي End Sub استخراج حالة الطالب ومواد الرسوب.rar

شرح مبسط لطريقة عمل الكود Sub YASSER_ELARABY() 'YASSER_ELARABY Dim ARR Dim ARRY Dim ARRYS Dim R As Long Dim X As Long Dim ALL_LESS As String Const STATUS As Byte = 101 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 102 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 112 ' عمود الجنس ذكر او انثى '_____________________________________________________ Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 7 ' اول صف لاسماء الطلاب Const NAME_LAST As Long = 206 + NAME_FIRST ' عدد الطلاب '_____________________________________________________ ARR = Array(9, 18, 27, 36, 46, 52, 54, 59, 64, 69, 78) ' اعمدة اختبار الفصل الدارسي الثاني لجميع المواد ARRY = Array(13, 22, 31, 40, 51, 52, 57, 62, 67, 72, 82) 'اعمدة الدرجة النهائية لجميع المواد ARRYS = Array(5, 14, 23, 32, 41, 52, 53, 58, 63, 68, 74) 'اعمدة اسماء كل المواد '_____________________________________________________ With Sheet2 'اسم شيت البيانات For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next Application.ScreenUpdating = False 'الغاء تحديث الشاشة 'هذا الجزء خاص بمادة العلوم تحديدا الفصل الدراسي الثاني لانه مقسم على عمودين فتم اضافة هذا الجزء ليتم معالجة هذه المرحلة If ARR(X) = 46 Then 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If Val(.Cells(R, ARR(X))) + Val(.Cells(R, ARR(X) + 1)) < Val(.Cells(LESS_ROW, ARR(X))) Or .Cells(R, ARR(X)) = "غ" Or .Cells(R, ARR(X) + 1) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " GoTo 86 'هنا يتم تخطى عمل الكود بالاسفل حتى لايتم معالجة مادة العلوم مرة اخرى Else GoTo 86 'وهنا ايضا يتم تخطى مادة العلوم الى المادة الاخرى End If End If 'هنا يتم مقارنة المواد بالدرجة الصغرى الخاصة الفصل الدارسي الثاني في اول الكود او اذا كانت غياب يتم اضافة اسم المادة من صف المواد الى المتغير 'ALL_LESS 'او مقارنة الدرجة النهائية لكل مادة بالدرجة الصغرى لها او اذا كانت غياب اذا تحقق الشرط فيتم اضافة المادة الى المتغير 'ALL_LESS If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" _ Or .Cells(R, ARRY(X)) < .Cells(LESS_ROW, ARRY(X)) Or .Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " End If ' 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد '_____________________________________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = 1 Then .Cells(R, STATUS) = "ناجح " 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = 2 Then .Cells(R, STATUS) = "ناجحة " 'اذا كانت انثى يتم وضع ناجحه If .Cells(R, GENDER) = 1 Then .Cells(R, NOTES) = "ومنقول " & INFO.Range("B14") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = 2 Then .Cells(R, NOTES) = "ومنقولة " & INFO.Range("B14") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = 1 Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = 2 Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True 'اعادة تحديث الشاشة End Sub الكود به بعض التعديلات البسيطة

اخي احمد لا داعي لتكرار الموضوع فقد تم الاجابة عن طلبك سابقا بأكثر من حل تفضل رابط الموضوع القديم https://www.officena.net/ib/topic/72005-فصل-أسماء/

تفضل اخي الكريم ابن بنها الدالة المعرفة وجدت انها لن تصلح لمثل هذه البيانات فكتبت لك هذا الكود لعله يفي بالغرض مع العلم اني كتبت كود اخر لنفس الملف الذي ارفقته منذ فترة ولكن هذا الكود افضل نوعا ما من السابق تفضل الكود Sub YASSER_ELARABY() 'YASSER_ELARABY Dim ARR Dim ARRY Dim ARRYS Dim ALL_LESS As String Const STATUS As Byte = 101 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 102 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 112 ' عمود الجنس ذكر او انثى '_____________________________________________________ Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 7 ' اول صف لاسماء الطلاب Const NAME_LAST As Long = 206 + NAME_FIRST ' عدد الطلاب '_____________________________________________________ ARR = Array(9, 18, 27, 36, 46, 52, 54, 59, 64, 69, 78) ' اعمدة اختبار الفصل الدارسي الثاني لجميع المواد ARRY = Array(13, 22, 31, 40, 51, 52, 57, 62, 67, 72, 82) 'اعمدة الدرجة النهائية لجميع المواد ARRYS = Array(5, 14, 23, 32, 41, 52, 53, 58, 63, 68, 74) 'اعمدة اسماء كل المواد '_____________________________________________________ For R = NAME_FIRST To NAME_LAST For X = 0 To UBound(ARR) On Error Resume Next If ARR(X) = 46 Then If Val(Cells(R, ARR(X))) + Val(Cells(R, ARR(X) + 1)) < Val(Cells(LESS_ROW, ARR(X))) Or Cells(R, ARR(X)) = "غ" Or Cells(R, ARR(X) + 1) = "غ" Then ALL_LESS = ALL_LESS & Cells(NAM_ROW, ARRYS(X)) & " - " GoTo 86 Else GoTo 86 End If End If If Cells(R, ARR(X)) < Cells(LESS_ROW, ARR(X)) Or Cells(R, ARR(X)) = "غ" _ Or Cells(R, ARRY(X)) < Cells(LESS_ROW, ARRY(X)) Or Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & Cells(NAM_ROW, ARRYS(X)) & " - " End If 86 Next X '_____________________________________________________ If ALL_LESS = "" Then If Cells(R, GENDER) = 1 Then Cells(R, STATUS) = "ناجح " If Cells(R, GENDER) = 2 Then Cells(R, STATUS) = "ناجحة " If Cells(R, GENDER) = 1 Then Cells(R, 102) = "ومنقول " & INFO.Range("B14") If Cells(R, GENDER) = 2 Then Cells(R, 102) = "ومنقولة " & INFO.Range("B14") ElseIf ALL_LESS <> "" Then If Cells(R, GENDER) = 1 Then Cells(R, STATUS) = "له دور ثان في" If Cells(R, GENDER) = 2 Then Cells(R, STATUS) = "لها دور ثان في" Cells(R, 102) = Left(ALL_LESS, Len(ALL_LESS) - 2) ALL_LESS = Empty End If Next R End Sub مرفق الملف استخراج مواد الرسوب للمحترم ياسر العربي.rar

بتغلط ماشي اعملها بكود هي كمان بقي واستخدم الCHR فيها كمان وبعدين انت مش عايش في البلد كل المصطلحات دي اتغيرت خلاص يعني كلمة هنخش دي بتدرس يامعلم وحياتك لاعملك مصفوفة (تهزيق) هدية ليك اصبر عليا مع تحيات العربي صناع الثقة

ارفق مثال ليتضح المقال ياريت مثال بسيط توضح بيه المطلوب وشكرا

ومضة : : احنا هنخش على شغل بعض ولا ايه تسلملي ياغالي تقبل تحياتي