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

تضبيط كود ترحيل


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

أخى الفاضل

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

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

أرجو التوضيح

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

السلام عليكم أخوتي الكرام

تفضل أخي ناصر ما طلبت

طبعا الأكواد من إبداعات أستاذنا العالم خبور و عدلتها لتناسب ملفك

جرب و اخبرني بالنتيجة

لا تنسانا من صالح الدعاء

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

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

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