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

هل هذا ماتريد ؟؟؟؟؟؟؟ db1 (4).mdb

السلام عليكم و رحمة الله تم الغاء شرط العدد 40 سواء بالنسبة للذكور او الاناث و اصبح الشرط هو انتماء التلميذ للفصل و النوع فقط ..هذا و الله ولى التوفيق Sub AdClass() Const K1 = "ذكر": Const K2 = "أنثى" Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, p As Long, q As Long Dim Fsl As String, C As Range Application.ScreenUpdating = False Set Sh = Sheets("بيانات"): Set ws = Sheets("فصول") ws.Range("D10:I49") = "": ws.Range("K10:P49") = "" LR = Sh.Range("E" & Rows.Count).End(3).Row Fsl = ws.Range("O7").Value For Each C In Sh.Range("J10:J" & LR) If C.Value = Fsl And C.Offset(0, -3) = K1 Then p = p + 1 ws.Range("D" & p + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value ElseIf C.Value = Fsl And C.Offset(0, -3) = K2 Then q = q + 1 ws.Range("K" & q + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value End If Next Application.ScreenUpdating = True End Sub

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

لما لا تقوم بدمجهم كلهم بصفحة واحدة في نفس الملف .

مشكلته كانت بسيطة لكن مؤثرة ومحيرة بعض الشيء اسم الورقة الموجودة في الكود ليست نفسه كما في داخل الورقة . من الوهلة الاولى عند النظر اليها تعتقد انها نفس الشيء( لتجنب هكذا مشاكل استخدم خاصية copy & paste) الشي الثاني يجب ايضا ان تشير للورقة لهذا السطر ايضا If Sheet1.Cells(i, 4) - Date >= 0 And Sheet1.Cells(i, 4) - Date <= 30 Then اتمنى ان تكون الامور جيدة الان . تذكير بتاريخ انتهاء العقود.xlsm

السلام عليكم ورحمة الله اخى الكريم جرب هذا الكود ..لو لك طلبات غير و اضحة فى مشاركتك الاولى يرجى توضيحها لآن الملف البببانات فيه غير كافية سواء من ناحية عدد الفصل الواحد او النوع بحيث نتمكن من اختبار الكود جيدا ..ارجو الاجابة بوضوح بعد التجربة ..اليك الكود Sub AdClass() Const K1 = "ذكر": Const K2 = "" Dim Sh As Worksheet, ws As Worksheet Dim Arr As Variant, Tmp As Variant Dim LR As Long, p As Long, i As Long, ii As Long, j As Long Dim Fsl As String, C As Range Application.ScreenUpdating = False Set Sh = Sheets("بيانات"): Set ws = Sheets("فصول") ws.Range("D10:I49") = "": ws.Range("K10:P49") = "" LR = Sh.Range("E" & Rows.Count).End(3).Row Fsl = ws.Range("O7").Value For Each C In Sh.Range("J10:J" & LR) If C.Value = Fsl Then p = p + 1 If p <= 40 Then On Error Resume Next ws.Range("D" & p + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value Else ws.Range("K" & p - 31).Resize(, 6).Value = Sh.Range("D" & C.Row + 40).Resize(, 6).Value End If End If Next Application.ScreenUpdating =true End Sub

يمكنك ذلك بهذه المعادلة =INDEX($C$17:$R$24,MATCH($F$5,$B$17:$B$24,0),MATCH($J$5,$C$15:$R$15,0)) 1اسعار العملات.xlsx

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

السلام عليكم ورحمة الله استخدم هذا الكود Sub SeaechData() Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, i As Long, C As Range Dim ShNam As String Set Sh = Sheets("ورقة11") For Each ws In Worksheets If ws.Name <> Sh.Name Then LR = ws.Range("A" & Rows.Count).End(3).Row i = 7 Do While Sh.Cells(i, 6) <> "" For Each C In ws.Range("A1:A" & LR) If C.Value = Sh.Cells(i, 6) Then ShNam = ws.Name Sh.Cells(i, 7) = ShNam End If Next i = i + 1 Loop End If Next End Sub