عمل قوائم للفصول تلقائية

[محمود محمد عبدو]

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

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

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

طلبة الصف الاول 2020.xlsm

[أحمد يوسف]

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

https://www.officena.net/ib/topic/85708-قوائم-فصول/?tab=comments#comment-543448

[وجيه شرف الدين]

بعد اذن استاذنا الفاضل استاذ احمد اتفضل الملف لعله يفى بالغرض

نسخة من طلبة الصف الاول 2020.xlsm

تم تعديل أكتوبر 5, 2019 بواسطه وجيه شرف الدين

[محمود محمد عبدو]

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

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

مشكووور اخى وجيه شرف الدين بارك الله فيكم بس الملف شغال فقط حتى 1 / 10 مش عارف ليه

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

[سليم حاصبيا]

للمرة الالف اكررر لا يمكن ادراج خلايا مدمجة في اي جدول من جداول الاكسل

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

الكود 

Option Explicit
Private Sub Worksheet_Activate()
GetUnique
End Sub
'++++++++++++++++++++++++++++++++++++++++++++

Sub GetUnique() 'VBA to extract unique items (with the dictionary)
Dim L As Worksheet
Dim T As Worksheet
Dim TLr%, i%
Dim LRG As Range
Dim obj As Object
Set L = Sheets("list"): Set T = Sheets("total")

 TLr = T.Cells(Rows.Count, 5).End(3).Row
Set LRG = T.Range("e2:e" & TLr)
Set obj = CreateObject("scripting.dictionary")
With obj
For i = 2 To TLr - 1
.Item(T.Cells(i, 5).Value) = ""
Next
With Sheets("list").Range("D2").Validation
.Delete
.Add 3, Formula1:=Join(obj.keys, ",")
End With
End With
Set obj = Nothing
End Sub
'++++++++++++++++++++++++++++++++++++++++++

Sub filter_me()
Dim L As Worksheet
Dim T As Worksheet
Dim TLr%, i%, Max_row%
Dim LRG As Range

Set L = Sheets("list"): Set T = Sheets("total")
L.Range("B4").Resize(1000, 4).ClearContents
 TLr = T.Cells(Rows.Count, 5).End(3).Row
Set LRG = T.Range("A1:J" & TLr)
On Error Resume Next
 If T.FilterMode Then
   T.ShowAllData: LRG.AutoFilter
 End If
On Error GoTo 0
LRG.AutoFilter 5, L.Range("D2")
Max_row = LRG.Rows.Count
 With LRG.Offset(1).Resize(Max_row - 1).SpecialCells(2, 23)
 .Columns(1).Copy: L.Range("B4").PasteSpecial xlPasteValues
 .Columns(9).Copy: L.Range("C4").PasteSpecial xlPasteValues
 End With
 On Error Resume Next
If T.FilterMode Then
   T.ShowAllData: LRG.AutoFilter
 End If
On Error GoTo 0
End Sub

الملف

 

first_20.xlsm

[محمود محمد عبدو]

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

بمعنى عند اختيار الكهرباء العام بيعطى الفصلين على بعض ودا مش هينفع لان الكهرباء فصلين 1 / 1 ، 1 / 2 معلش انا عارف انى بتعبك حبيبى واخى سليم حاصبيا بس دا عشمنا فيكوا 

[سليم حاصبيا]

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

first_20 New.xlsm