اذهب الي المحتوي
أوفيسنا

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

قام بنشر

أخى الفاضل

فى صفحة (أسماء الدور الثانى ) يوجد أربعة مواد فقط هى العربى والرياضيات والانجليزى والدين فقط

بينما فى صفحة ( الشيت ) يوجد 10 مواد  فهل تريد اهمال ترحيل المواد الباقية

أرجو التوضيح

قام بنشر
Sub كشف_دور_ثاني()
On Error Resume Next
Dim T As Integer, Y As Integer, Z As Integer, V As Integer _
, N As Integer, X As Integer, R As Integer, M As Integer _
, C As Integer, CC As Integer

مسح_كشف_دور_ثاني
'هنا نكتب مدى العمود الذي به كلمة ناجح أو راسب من الشيت الأصلي
T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "<>ناجح") / 30
'================================
Application.ScreenUpdating = False
With ActiveSheet
    Y = (T * 38) + 39
    .PageSetup.PrintArea = Range("B2:N" & Y).Address
End With
'================================
Z = 40
Range("نموذج_كشف2").Copy
For V = 1 To T
    Range("B" & Z).PasteSpecial xlPasteAll
    Set ActiveSheet.HPageBreaks(V).Location = Range("B" & Z)
    Z = Z + 38
Next V
Application.CutCopyMode = False
'================================
N = 6
With Sheet1
    X = .Range("A" & .Rows.Count).End(xlUp).Row
    For R = 11 To X
        If .Range("CZ" & R) <> "ناجح" Then
            M = M + 1
            Cells(M + N, 2) = M
            For C = 1 To 12 'نعدل هذا الرقم ليكون عدد الأعمدة في صفحة الراسبين التي نرحل إليها البيانات
          'هنا نكتب أرقام أعمدة المواد التي نريد جلب البيانات منها
                CC = Choose(C, 3, 2, 26, 35, 44, 53, 64, 69, 74, 84, 94)
                Cells(M + N, C + 2) = .Cells(R, CC)
            Next C
            If M Mod 30 = 0 Then N = N + 8
        End If
    Next R
End With
Range("A2").Activate
'================================
Application.ScreenUpdating = True
MsgBox "تم ترحيل   " & M & "   طالب دور ثاني", vbMsgBoxRight, "الحمدلله"
معاينة
On Error GoTo 0
End Sub
Sub مسح_كشف_دور_ثاني()
Dim Y As Integer
Application.ScreenUpdating = False
    With ActiveSheet
        Y = .UsedRange.Rows.Count + 40
        .Rows("40:" & Y).Delete
        'نغير الرقم (13) ليكون بعدد أعمدة البيانات في الصفحة المرحل اليها
        Range("نموذج_كشف2").Offset(5, 0).Resize(30, 13).ClearContents
        .PageSetup.PrintArea = Range("نموذج_كشف2").Address
    End With
    ActiveWindow.ScrollRow = 2

 

تفضل الشرح أخي الكريم أما الطلب الثاني محتاج نظر

قام بنشر
T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "<>ناجح") / 30

اشكرك اخي الكريم

ولي هنا سؤال السنا في المدي DI

ومادخل المدي CZ

و اي جزئيه التي يقف عندها الكود حتي لاياتي بالصفحات الكثيره البيضاء

قام بنشر

T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "<>ناجح") / 30

اشكرك اخي الكريم

ولي هنا سؤال السنا في المدي DI

ومادخل المدي CZ

و اي جزئيه التي يقف عندها الكود حتي لاياتي بالصفحات الكثيره البيضاء

عندك حق أخي المفروض CZ تعدل إلى DI

لكي يقف الكود و لا يأتي بصفحات كثيرة بيضاء عدل السطر التالي

T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "<>ناجح") / 30

 

ليكون

T = Application.CountIf(Sheet1.Range("DI11:DI110"), "<>ناجح") / 30
قام بنشر

(cz) و امتداده®

ماذا تعني بها

امتداده  يرمزله الأستاذ خبور بالحرف R

و يعني العمود CZ من أول الصف 10 و حتى الصف 110 و لكن اختر منهم كل من هو له دور ثان

جرب وضع كلمة ناجح في وسط الراسب ستجد أنه يهملها

قام بنشر

جزاك الله خيرا

واذا كان عدد الطلاب مثلا 600  لماذا وقفنا عند العدد 110

الاوراق البيضاء الكثيره التي كانت تظهر اصبحت تظهر ورقتان بيضاء زياده

قربنا ان شاء الله

ربنا يجزيك الخير

قام بنشر

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

قام بنشر (معدل)

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

 

أخي الكريم، تم تعديل طفيف جدا على الكود الرائع لأخينا الحبيب "عبد الله" المقدم من أخي الحبيب "أيسم" (استبدلت الصيغة "ناجح<>" في تعيين قيمة T في بداية الكود بالصيغة "دور ثاني") وذلك لمعاينة (أو طباعة) الكشف للطلاب الذين لهم دور ثاني فقط (دون الفراغات للصفحات التي لا تحوي طلابا لهم دور ثاني)... أرجو أن يكون هذا المطلوب... 

 

أخوكم بن علية

 

ترحيل الدور الثاني.rar

تم تعديل بواسطه بن علية حاجي
قام بنشر

الله يبارك لك .. الله يبارك لك..

الله يبارك لك .. الله يبارك لك

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

الله يبارك لك .. الله يبارك لك

  • 1 month later...

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