كود ادراج الشعبة

[أ/حكيم]

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

الشعب.zip

[أ/حكيم]

?????????????

[أبو محمد عباس]

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

الاخ الاستاذ حكيم

ارفقت لك ملف فيه كود لاحد الاخوة الاعزاء وفيه تنفيذ لما تطلبه

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

تقبل فائق احترامي وتقديري

 

ترتيب.rar

[أبوعيد]

السلام عليكم 

أرجو أن تشرح مطلوبك أكثر 

[أ/حكيم]

شكرا للاخوة أبو محمد و أبو عبيد المطلوب أن يوزع رموز الشعب أمام كل طالب حسب عدد الشعب فيي حالة وجود 100 طالب وعدد الشعب 5 يعمل لأول 20 طالب الرمز  أ  ومن 21 إلى 40 الرمز  ب  وهكذا ويكون الطلاب الزيادة موزعين في الشعب الأولى .... وشكرا .

تم تعديل ديسمبر 8, 2013 بواسطه أ/حكيم

[الخالدي]

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

جرب الكود التالي

Sub AL_KHALEDIادراج_الشعب()
Set نظاق_الشعب = [H3]
Set نظاق_التعبئة = [D2:D33]
عددالشعب = [F3]
عددالصفوف = نظاق_التعبئة.Rows.Count
عددالتكرار = Int(عددالصفوف / عددالشعب)
الفارق = عددالصفوف Mod عددالشعب
For شعب = 1 To عددالشعب
    If الفارق > 0 Then
        عددالشعبةالحالية = عددالتكرار + 1
        الفارق = الفارق - 1
    Else
        عددالشعبةالحالية = عددالتكرار
    End If
    For شعبة = 1 To عددالشعبةالحالية
        الصف = الصف + 1
        نظاق_التعبئة(الصف, 1).Value = نظاق_الشعب(شعب, 1).Value
    Next
Next
Set نظاق_الشعب = Nothing: Set نظاق_التعبئة = Nothing
End Sub

في امان الله 

ادراج الشعب.rar

[عبدالله باقشير]

السلام عليكم

كود جميل اخي الحبيب الخالدي

كنت اعمل على هذا الكود قبل ان ارى مشاركتكم

Sub kh_Start()
Dim R As Integer, RR As Integer, RRR As Integer, iCont As Integer
Dim Lr As Long

iCont = [F3]
Lr = Cells(Rows.Count, "B").End(xlUp).Row - 1
Range("D2").Resize(Lr, 1).ClearContents
With Range("H3")
    For R = 1 To iCont
        RRR = Abs(Int(-(Lr - RR) / (iCont - (R - 1))))
        Range("D2").Cells(RR + 1, 1).Resize(RRR, 1).Value = .Cells(R, 1).Value
        RR = RR + RRR
    Next
End With
End Sub

تحياتي

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب الخالدي حفظكم الباري عز وجل ورعاكم

كود رائع وممتاز جعله الله في ميزان حسناتك

تقبل فائق احترامي وتقديري

[أبو محمد عباس]

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

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

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

تقبل فائق احترامي وتقديري

[أ/حكيم]

اأساتذتنا الكبار زادكم الله علماً ونوراً وبارك الله فيكم  وجزاكم عنا خيرا ...................... 

[عبدالله باقشير]

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

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

تقبلوا تحياتي وشكري