اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

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

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

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

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

رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

تم تعديل بواسطه وجيه شرف الدين
  • Like 1
رابط هذا التعليق
شارك

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

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

مشكووور اخى وجيه شرف الدين بارك الله فيكم بس الملف شغال فقط حتى 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

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information