تعديل بسيط على كود توزيع الطلاب

[قصي]

السلام عليكم ورحمة الله

هذا ملف به صفحة ببيانات الطلاب وصفحة اخري بها استدعاء للطلاب ولكن عند كتابة العدد 19 او 11 تاتي النتائج خطأ

ولااعرف السبب

توزيع الطلاب1.rar

[ايمن ريا]

السلام عليكم : عدد الصفوف الخارجة عن التوزيع في ورقة البيانات المفروض 8 وليس 9 .

[قصي]

اشكرك استاذ ايمن رايه جزاك الله خيرا وحشتنا

الخطأ الذي اقصده هو في التوزيع

انظر الى عدد الطلاب في كل لجنة ستجد اخر لجنه عددها 2 وهذا خطأ فعلي

[قصي]

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

اريد شرح لهذا الكود وفي هذه الحالة

سيتم اكتشاف الخطأ في توزيع عدد طلاب كل لجنه

هذا هو الكود الاصلي للعلامة عبد الله باقشير

Sub KH_START()
    On Error Resume Next
    Dim MyRang_1 As Range, MyRang_2 As Range, MyRang_Formats As Range
    Dim S As Integer, E As Integer, W As Integer, V As Integer, T As Integer, TT As Integer _
    , H As Integer, M As Integer, Y As Integer, Z As Integer, N As Integer, U As Integer _
    , R As Integer, C As Integer, CC As Integer, O As Integer, EE As Integer, SS As Integer
    '=======================================
    If [B2] = False Then MsgBox "تاكد من الشرط في الخلية B2", vbMsgBoxRtlReading, "تنبيه": GoTo 1
    '=======================================
    
                        'اسم ورقة مصدر البيانات
    S = Application.CountA(ورقة1.Range("B6:B1005"))  ' عددالطلبة
    E = [E2]    ' عدد طلاب اللجنة
    T = Application.RoundUp(S / (E * 3), 0)  ' عدد الكشوفات
    TT = Application.RoundUp(S / E, 0)
    W = 7     ' عدد الصفوف الخارجة عن التوزيع في ورقة الكشوفات
    V = 5     ' عدد الصفوف الخارجة عن التوزيع في ورقة البيانات
    H = E + 4 + 3  ' عدد طلاب اللجان زايدا رؤؤس الاعمدة والتذييل
    Set MyRang_1 = Range("راس_اللجان")
    Set MyRang_2 = Range("تذييل_اللجان")
    Set MyRang_Formats = Range("فورمات")
    KH_Clear
    '================================
    Application.ScreenUpdating = False
    ActiveWindow.View = xlPageBreakPreview
    '================================
    For M = 1 To T
        If M <> 1 Then
            MyRang_1.Copy Range("B" & W - 3)
            Set ActiveSheet.HPageBreaks(M - 1).Location = Range("B" & W - 3)
        End If
        Y = 2
        For Z = 1 To 3
            EE = Application.RoundUp((S - (V - 5)) / (TT - SS), 0)
            SS = SS + 1
            MyRang_Formats.Copy
            Cells(W + 1, Y).Resize(E, 5).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            MyRang_2.Copy Cells(W + E + 1, Y)
            For N = 1 To EE
                U = N + W: R = N + V
                For C = 1 To 4
                    CC = Choose(C, 11, 2, 8, 10)
                    
                    'اسم ورقة مصدر البيانات
                    Cells(U, Y + C) = ورقة1.Cells(R, CC)
                Next C
                If Cells(U, Y + 1) <> "" Then Cells(U, Y) = N
            Next N
            V = V + EE: Y = Y + 6
        Next Z
        W = W + H
    Next M
    '================================
    ActiveWindow.View = xlNormalView
    With ActiveSheet
        O = .UsedRange.Rows.Count
        .PageSetup.PrintArea = .Range("B4:R" & O).Address
    End With
    '================================
    Application.ScreenUpdating = True
    Range("A4").Activate
    معاينة
    On Error GoTo 0
1 End Sub
Sub KH_Clear()
    Dim Y As Integer
    Application.ScreenUpdating = False
    
'اسم ورقة كشوفات اللجان
    With ورقة2
        Y = .UsedRange.Rows.Count + 8
        .Range("B8:R" & Y).Delete
        .PageSetup.Zoom = 92
        .PageSetup.PrintArea = .Range("B4:R1000").Address
    End With
End Sub
Sub معاينة()
    ActiveWindow.SelectedSheets.PrintPreview
End Sub

[ibn_egypt]

اخى الفاضل

 

تم ايجاد خطأ بسيط في الملف المرفق بالمشاركة رقم 1 لك وهو الذي يتسبب بالخطأ في التوزيع وتم تعديله

 

الخطأ في هذا السطر

EE = Application.RoundUp((S - (V - 6)) / (TT - SS), 0)

والمفترض أن يكون 

EE = Application.RoundUp((S - (V - 8)) / (TT - SS), 0)

مرفق الملف بعد التعديل

 

تحياتي  

كشف المناداة.rar

[قصي]

بارك الله لك يا استاذ ابن مصر

ولي سؤال مامعنى هذه الارقام ال6 والرقم 8

لو تكرمت اشرح الكود

وياسلام لو خليت هذا الكود بالطريقه السهله مثل هذه البدايه

Const StudentData As String = "بيانات الطلبة"
Const TopStudents As String = "الاوائل"

[ناصر سعيد]

موضوع هام جزاكم الله خيرا وبارك فيكم .. للرفع

[ناصر سعيد]

اخى الفاضل

 

تم ايجاد خطأ بسيط في الملف المرفق بالمشاركة رقم 1 لك وهو الذي يتسبب بالخطأ في التوزيع وتم تعديله

 

الخطأ في هذا السطر

EE = Application.RoundUp((S - (V - 6)) / (TT - SS), 0)

والمفترض أن يكون 

EE = Application.RoundUp((S - (V - 8)) / (TT - SS), 0)

مرفق الملف بعد التعديل

 

تحياتي  

 

ماذا يعني هذا الرقم لو سمحتم

 

[ibn_egypt]

 

ماذا يعني هذا الرقم لو سمحتم

 

 

يعني عدد الصفوف الخارجة عن التوزيع في ورقة البيانات

 

تحياتي  

[inas aly]

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

[ناصر سعيد]

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

[ناصر سعيد]

للرفع

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