ياسر أحمد الشيخ قام بنشر أغسطس 4, 2016 مشاركة قام بنشر أغسطس 4, 2016 (معدل) السلام عليكم ورحمه الله وبركاته أريد عمل قائمة بأسماء الطلاب مرتبة أبجدياً وغير مكررة مجمعة من عدة شيتات (class1-class2-class3-class4-class5) الرجاء استخدام الكود لعمل ذلك ملحوطة : هى ليست Listbox او Combobox وإنما أريدها قائمة مكتوبة فى نطاق خلايا أكسل (مثلاً فى النطاق b3:b50) أرجو الافادة Data.rar تم تعديل أغسطس 4, 2016 بواسطه ياسر أحمد الشيخ رابط هذا التعليق شارك More sharing options...
عبدالسلام ابوالعوافي قام بنشر أغسطس 4, 2016 مشاركة قام بنشر أغسطس 4, 2016 Data.rar 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 4, 2016 مشاركة قام بنشر أغسطس 4, 2016 جرب هذا الملف Data salim.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أغسطس 6, 2016 مشاركة قام بنشر أغسطس 6, 2016 أخي الكريم جرب الكود التالي Sub UniqueListFromMultipleSheets() Dim X, Y(), I&, J&, K&, WS As Worksheet ReDim Y(1 To Rows.Count, 1 To 1) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each WS In ThisWorkbook.Worksheets(Array("Class1", "Class2", "Class3", "Class4", "Class5")) X = WS.Range("B3:B" & WS.Cells(Rows.Count, "B").End(xlUp).Row).Value For I = 1 To UBound(X) If Len(X(I, 1)) Then If Not .Exists(X(I, 1)) Then J = J + 1 .Item(X(I, 1)) = J Y(J, 1) = X(I, 1) End If End If Next I Next WS End With With Sheets("Report") .Range("C3").Resize(J, 1).Value = Y() End With End Sub ستظهر القائمة في الخلية C3 في ورقة العمل Report >> أو إذا أردت في الخلية B3 قم بإزالة الجدول وجعل النطاق نطاق عادي ثم غير المرجع في الكود تقبل تحياتي رابط هذا التعليق شارك More sharing options...
ياسر أحمد الشيخ قام بنشر أغسطس 7, 2016 الكاتب مشاركة قام بنشر أغسطس 7, 2016 (معدل) شكرا لكم اخوانى على الردود ولكن أنا أفضل كود الأخ الكريم عبدالسلام ابوالعوافي وذلك لأن الكود الخاص به مختصر جداً وهذا ما أريده ، بس هناك تعديلات عايز أعملها على الكود: 1- أسماء الشيتات مختلفة وليست مرقمة كما بالملف class1 ، ارجو الغاء الاعتماد على الأرقام فى اسم الشيت 2- أريد زيادة نطاق الأسماء حيث أن الأسماء عندى تجدها 100 فى class وممكن تجدها 150 فى class آخر وهكذا 3-أريد عمل ترقيم تلقائى بجوار الأسماء شكرا مقدماً تم تعديل أغسطس 7, 2016 بواسطه ياسر أحمد الشيخ رابط هذا التعليق شارك More sharing options...
ياسر أحمد الشيخ قام بنشر أغسطس 8, 2016 الكاتب مشاركة قام بنشر أغسطس 8, 2016 للرفع........للرفع رابط هذا التعليق شارك More sharing options...
عبدالسلام ابوالعوافي قام بنشر أغسطس 9, 2016 مشاركة قام بنشر أغسطس 9, 2016 (معدل) جرب Sub Awafi() Dim i, ii, iii As Integer, sh As Worksheet Sheet6.Range("b:b").ClearContents iii = 3 For Each sh In Sheets If Not sh.Name = "Report" Then For ii = 3 To 200 If Len(sh.Cells(ii, 2)) = 0 Then Exit For If Application.WorksheetFunction.CountIf(Sheet6.Range("b3:b" & iii), _ sh.Cells(ii, 2)) = 0 Then _ Sheet6.Cells(iii, 2) = sh.Cells(ii, 2): Sheet6.Cells(iii, 1) = iii - 2 _ : iii = iii + 1 Next ii End If Next sh ActiveWorkbook.Worksheets("Report").Sort.Apply End Sub مع العلم اخي العزيز ياسر .. مانقدمه في الغالب هو فكرة الحل وليس الحل المتكامل .. فيمكنك اضافة اوتعديل على الاكواد بما يناسب عملك .. بالتوفيق تم تعديل أغسطس 9, 2016 بواسطه عبدالسلام ابوالعوافي 1 رابط هذا التعليق شارك More sharing options...
ياسر أحمد الشيخ قام بنشر أغسطس 9, 2016 الكاتب مشاركة قام بنشر أغسطس 9, 2016 شكرا لك أخىعبدالسلام ابوالعوافي شكرا لك أخى ياسر خليل أبو البراء شكرا لك أخى سليم حاصبيا حلول أكثر من رائعة تمت الاجابة شكرا لك أخىعبدالسلام ابوالعوافي شكرا لك أخى ياسر خليل أبو البراء شكرا لك أخى سليم حاصبيا حلول أكثر من رائعة تمت الاجابة رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان