فصل الطلبة اللى عندهم غياب فى بعض المواد

[mohamed abdelhalim]

كيف الطريقة من غير دوال معقدة

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

درجات الصف الثالث.xlsx

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

المعادلة لا تقوم  بازاحة الصفوف من مكانها

و ريثما تقوم شركة مابكروسوفت باحتراع هكذا معادلة علينا فقط استعمال الــ VBA

الكود

Option Explicit
Sub Get_Std_Names()
    Dim G As Range
    Dim H As Range
    Dim Ro_All%, ro_H%, i%, m%, n%
    Dim str$

str = "غ"
Ro_All = ALL.Cells(Rows.Count, 2).End(3).Row
    If Farz.Range("b1").CurrentRegion.Rows.Count > 1 Then
     Farz.Range("b1").CurrentRegion.Offset(1). _
     Resize(Farz.Range("b1").CurrentRegion.Rows.Count - 1). _
     Clear
    End If
For i = 2 To Ro_All
 If Application.CountIf(ALL.Cells(i, 3).Resize(, 6), str) = 0 Then
  m = m + 1
        If G Is Nothing Then
            Set G = ALL.Cells(i, 2).Resize(, 7)
        Else
            Set G = Union(G, ALL.Cells(i, 2).Resize(, 7))
        End If
 Else
 n = n + 1
   If H Is Nothing Then
            Set H = ALL.Cells(i, 2).Resize(, 7)
        Else
            Set H = Union(H, ALL.Cells(i, 2).Resize(, 7))
        End If
 End If
Next
G.Copy Farz.Cells.Cells(2, 2)
Farz.Range("a2").Resize(m) = _
Evaluate("Row(" & 1 & ":" & m & ")")

H.Copy Farz.Cells.Cells(m + 2, 2)
Farz.Range("A" & m + 2).Resize(n) = _
Evaluate("Row(" & 1 & ":" & n & ")")

Farz.Range("A2").Resize(m + n). _
Borders.LineStyle = 1

 Farz.Range("B1").CurrentRegion.Offset(1). _
 Resize(Farz.Range("B1").CurrentRegion.Rows.Count - 1). _
 InsertIndent 1
End Sub

الملف مرفق

 

Third_class.xlsm

[mohamed abdelhalim]

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

[احمد بدره]

بعد إذن أستاذنا الفاضل سليم

جرب هذا لعله يفي الغرض

تم عمل معادلة في العمود I لمعرفة الطالب غائب في إحدى المواد أو حاضر

وتم عمل معادلة في عمود م لجعل المسلسل يبدأ برقم 1

ملحوظة يجب قبل رفع ملف حفظ بنوع تمكين وحدات ماكرو

درجات الصف الثالث.xlsm

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

بعد اذن احي أحمد بدره

هذا الكود ربما يكون اسهل قليلاً (الشيت 3)

Option Explicit

Sub Get_data()
Dim S  As Worksheet
Dim T As Worksheet
Dim cret_rg As Range
Dim col%
Dim s_rg As Range
Set S = Sheets("Sheet2"): Set T = Sheets("Sheet3")
Set s_rg = S.Range("A1").CurrentRegion

  If T.Range("B3").CurrentRegion.Rows.Count > 1 Then
    T.Range("B3").CurrentRegion.Offset(1). _
    Resize(T.Range("B3").CurrentRegion.Rows.Count - 1).Clear
   End If

If s_rg.Rows(1).Find(T.Range("H1"), lookat:=1) Is Nothing Then Exit Sub
col = s_rg.Rows(1).Find(T.Range("H1"), lookat:=1).Column
  With T
    .Range("B3") = S.Range("A1")
    .Range("C3") = S.Range("B1")
    .Range("D3") = T.Range("H1")
    .Range("H2") = "غ"
     Set cret_rg = .Range("H1:H2")
     s_rg.AdvancedFilter 2, cret_rg, .Range("B3:D3")
    .Range("H2") = ""
  End With
End Sub

الملف مرفق

Class_3.xlsm

[احمد بدره]

بارك الله فيك أستاذنا ومعلمنا الفاضل

ولكن بعد إذن حضرتك

تم إضافة كود للتسلسل التلقائي في العمود A

Class_3.xlsm

[mohamed abdelhalim]

شكرا لكم جميعا وبارك الله فيما بذلتموة وجعلة الله فى ميزان حسناتكم

[أحمد يوسف]

  mohamed abdelhalim

فين انت من كل هذه الإجابات الممتازة ؟!!!

أين الضغط على الإعــــجــــــاب لكل اجابات الأساتذة ؟!!!💙

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

1 ساعه مضت, احمد بدره said:

بارك الله فيك أستاذنا ومعلمنا الفاضل

ولكن بعد إذن حضرتك

تم إضافة كود للتسلسل التلقائي في العمود A

Class_3.xlsm 60.54 kB · 1 تنزيلات

استاذ أحمد

لا ضرورة لعمل حلقة تكرارية حتى 1000 صف (أكثر من 900 فارغ) بالاضافة الى شروط  IF  لوضع التسلسل (أرهاق اضافي للبرنامج)

يكفي اضافة ما موجود في المربع الأزرق من هذه الصورة