نجوم المشاركات

I don't like attaching files But I see there is a huge mess Click Down arrow first then use Up arrow File.xlsb

اخي ابو بهاء المصري / شكرا لخلقك وتفهمك لك منى كل التقدير والاحترام بالسبة للرسالة اثتاء الحفظ ليس له علاقة بالكود ولكن من خصائص اعدادات الاكسل وقد تم معالجتها قوائم لجان الدور الثاني اولي.xlsb

تم عمل المطلوب القائمة المنسدلة عدلت عليها 55.xlsx

Use this code Sub DropDownSelection() Dim v, x, ws As Worksheet, myDrop As DropDown Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("1") Set myDrop = ActiveSheet.DropDowns("myDropDown") v = myDrop.List(myDrop.Value) x = Application.Match(v, ws.Columns(3), 0) If Not IsError(x) Then With ActiveSheet .Range("C9").Value = ws.Cells(x, 3).Value .Range("J9").Value = ws.Cells(x, 4).Value 'complete by yourself End With End If Application.ScreenUpdating = True End Sub Assign macro to the drop down by right-click on the drop down and select Assign Macro and select the macro name [DropDownSelection]

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

طيب وبما انك وصلت للحل لتعم الفائدة Dim db As DAO.Database Dim rst As DAO.Recordset ' Open the database Set db = DBEngine.OpenDatabase(".\officenaDB.mdb") ' Open the Recordset Set rst = db.OpenRecordset ("SELECT * FROM Customers WHERE CustomerId = 'officena'", dbOpenDynaset)

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

الكود واحد مع تغيير معيار البحث وزيادة النطاق حسب بياناتك الصق في الخلية A2 واحب إلى أسفل الملون هو المطلوب تغييره =IFERROR(INDEX(الرئيسية!$C$2:$C$10;AGGREGATE(15;6;الرئيسية!$A$2:$A$23*1/--(الرئيسية!$D$2:$D$10="ســــــدد");ROW(A1));1);"") =IFERROR(INDEX(الرئيسية!$C$2:$C$10;AGGREGATE(15;6;الرئيسية!$A$2:$A$23*1/--(الرئيسية!$D$2:$D$10="ســــــدد");ROW(A1));1);"")

السلام عليكم ورحمة الله وبركاته اولا وقبل اى شئ سبحانك لا علم لنا الا ما علتنا يارب لك الحمد كما ينبغى لجلال وجهك ولعظيم سلطانك الحمد لله الذى هدانى وما كنت لأهتدى لولا أن هدانى الله ... طبعا لا انسى أفضال اساتذتى الكرام جزاهم الله خيرا ورزقهم سعادة الدارين ان شاء الله فلولا أفضالهم علينا بعد فضل رب العزة سبحانه ما كنا هنا ولا كان هذا حالنا ومن هنا أتوجة بكل الشكر والتقدير والإمتنان والعرفان بالجميل لك من تعلمت على يدية إما بطريق مباشر أو غير وأسال الله تعالى أن يكتب كل حرف تعلمته أنا وطلاب العلم هنا والطلاب الذى سيأتون من بعدنا فى موازين حسناتهم التى لا تنقطع ابدا يارب العالمين وأن ترزقهم القبول يارب.. آمين آمين آمين ------------------------------------------------------------------------------------------------------------------------------- ومثل ما ينحكى الجواب من العنوان بيبان منتظر رأيكم بعد التجربة وأتمنى لكم تحربة ممتعة هنا يوجد مرفقان - الاول الملف المضغوط هو قاعدة البيانات التى تحتوى على نموذج واحد فقط باسم ( frmExportObJects ) به كل الاكواد اللازمة لمن ارد نقله حتى لا اشق عليكم - الثانى بدون ضغط وهذه قاعدة بيانات للتجربة وضعت فيها كل الكائنات التى قد توجد بالقواعدة للتجربة ولم انسى الجداول المرتبطة أيضا Export Select Object To another db.zip Export Select Object To another db.mdb

تفضل اخي جرب تم تعديل الكود لجلب بيانات جميع الطلاب بشرط اختلاف في اي درجة من درجات المواد ولو كانت واحدة فقط . وتجاهل من لهم درجات متطابقة في جميع المواد Sub comparecells_MH() Dim i&, j&, k&, m&, RwsDest&, derlig& Dim a As Variant, b As Variant Dim WSData As Worksheet: Set WSData = Sheets("الكشف") Dim WSDest As Worksheet: Set WSDest = Sheets("فرزدرجات") derlig = WSDest.Range("C" & Rows.Count).End(xlUp).Row + 1 Application.ScreenUpdating = False a = WSData.Range("C6:T" & WSData.Range("D" & Rows.Count).End(3).Row).Value ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) For i = 1 To UBound(a, 1) - 1 Step 2 For j = 3 To UBound(a, 2) If a(i, j) <> a(i + 1, j) Then k = k + 1 For m = 1 To UBound(a, 2) b(k, m) = a(i, m) b(k + 1, m) = a(i + 1, m) Next k = k + 1 Exit For End If Next Next WSDest.Range("C6").Resize(UBound(b, 1), UBound(b, 2)).Value = b With WSDest.Range("C6:T" & WSDest.Cells.SpecialCells(xlCellTypeLastCell).Row) If .Row < 6 Then Exit Sub For Each r In .EntireRow If Application.CountA(Intersect(r, WSDest.Range("C:D"))) Then _ If Application.CountA(Intersect(r, WSDest.Range("E:T"))) = 0 Then Intersect(r, WSDest.Range("C:D")).EntireRow.Delete Next RwsDest = WSDest.Range("D" & Rows.Count).End(xlUp).Row With WSDest.Cells(6, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(RwsDest) .Formula = "=if(countifs(D:D,D6)>1,"""",1)" .Value = .Value Intersect(.SpecialCells(xlConstants).EntireRow, WSDest.Range("A:U")).Delete WSDest.Range("U6:U" & derlig).ClearContents End With End With Application.ScreenUpdating = True End Sub مطابقة درجات V1.xlsm

شكرا جزيلا

ينفع ان شاء الله if Age >=16 and Age <=32 Then Do Something Else Don't End If بالتوفيق

اجرب ايه مفيش مرفق

Select the drop down form control and rename it [myDropDown] in the Name Box Then put the following code in a standard module Sub Fill_DropDown_Form_Control() Dim ws As Worksheet, sh As Worksheet, myDrop As dropDown, r As Long, i As Long With ThisWorkbook Set ws = .Worksheets("1"): Set sh = .Worksheets(Join(Array(Chr(211), Chr(204), Chr(225), Chr(49)), Empty)) End With Set myDrop = sh.DropDowns("myDropDown") ReDim a(1 To 100) For r = 8 To ws.Range("I3").Value + 7 If ws.Cells(r, "K").Value = sh.Range("U1").Value Then i = i + 1 a(i) = ws.Cells(r, "C").Value End If Next r myDrop.RemoveAllItems If i > 0 Then ReDim Preserve a(1 To i) myDrop.List = a End If End Sub You have to put the grade in specific cell say cell U1 in the same worksheet of the drop down and also put the following code in the worksheet module Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("B1") = ActiveCell.Row End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$U$1" Then Call Fill_DropDown_Form_Control End Sub so simply to use the code, type the grade you want in cell U1 then the drop down will be filled with the names related to that grade

الاستاذ الفاضل/ ابوحبيبه هذا ملف تعقيبا علي مشاركتك ولاكن احب ان اضيف ان الكود ليس سهلا ويجب تتبع كل خطوة وخرجاتها حتي تعلم اين موضع التغير في الكود حتي يناسب تعديلك وكنت اتمني معاددلات داخل الخلايا وليس كود VBA ومازالت هناك مشكلة في احضار باقي الاسماء بعد الـ 20 اسم الاولي وواجهتني تلك المشكلة حينما طوعت الكود ليتناسب مع الورقة المسماه thania فضلا عن هذه الرسالة الت تاتيني عند الحفظ وارجو من الاستاذ lionheart ان يتقبل تعليقاتنا بكل صدر رحب قوائم لجان الدور الثاني اولي.xlsb

تم عمل لمطلوب =IF(MONTH($G5)=MONTH($F5);IF(MONTH($F5)=MONTH(I$3);$H5;"");IF(MONTH($F5)=MONTH(I$3);IF($H5+DAY($F5)>DAY(EOMONTH($F5;0));DAY(EOMONTH($F5;0))-DAY($F5)+1;$H5);IF(MONTH($G5)=MONTH(I$3);$H5-H5;""))) SL Data.xlsx

كاتب الاكواد.zip

Never mind my bro Abdullah Out target is not to get the best solution but to help others as possible as we can May Allah bless you

اتفضل بس نصيحة لوجه الله لا تستخدم الأحرف العربية فى تسمية الحقول والكائنات والعناصر وكذلك لا تحاول استخدامها فى محرر الأكواد لسببين 1- عند استخدامها تتداخل الأكواد وقد تعجز عن التعديل عليها مستقبلا وقد تعجز اساسا عن فهم الكود وبناء الجمل من النظر الى الترتيب المعكوس بسبب الأحرف العربية كما يحدث فى دوال المجال على سبيل المثال وليس الحصر 2- عند محاولة استخدام قاعدة البيانات فى ويندوز لم يتم اعداد اللغة الاقليمية الى اللغة العربية له يحدث خطأ ولا يتم تنفيذ الاوامر البرمجية وبالتالى لن تعمل القاعدة وقد لا تعرف من الرسالة أن اللغة العربية هى المشكلة ملاحظة وضعت عدد اتنين زر امر لزيادة ونقصان الكمية افضل من زيادتها بالضغط على اسم الصنف كما تريد ولكن ان اردت ذلك لا يوجد عندى ادنى مشكلة أنا وضعت أفضل تصور من وجهة نظرى آخذا فى الاعتبار كل ما خطر على بالى لإضفاء المرونة واليسر فى التعامل واخيرا اتفضل قاعدتك بعد التعديل ان شاء الله تجد ما تريد مثال إدراج الأصناف فى الفاتورة بشروط_( v 2 ).accdb