أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





ترحيل اعمدة وخلايا متعددة

السلام عليكم ورحمة الله وبركاته قمت بتعديل الكود الآتي للاستاذ ياسر .... لكن لا يقوم بالعمل معي في نفس الكود (- بترحيل ..



27-07-2020 06:46 مساء
نصر الإيمان
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 15-02-2018
رقم العضوية : 4397
المشاركات : 446
الجنس : ذكر
تاريخ الميلاد : 29-12-1985
يتابعهم : 8
يتابعونه : 4
قوة السمعة : 885
 offline 

السلام عليكم ورحمة الله وبركاته  
قمت بتعديل الكود الآتي للاستاذ ياسر .... لكن لا يقوم بالعمل معي في نفس الكود (- بترحيل بيانات الطلاب(الجلوس.الاسم). . . .  - او وضع اسم مادة التخلف .......- او وضع الملاحظات لهم )
Sub Transfer()
    Rem الإعلان عن المتغيرات ومنها مصفوفة سيكون عدد الأعمدة فيها 4 وتعبر عن النتائج
    Dim a(1 To 10000, 1 To 31), ws As Worksheet, sh As Worksheet, lr As Long, r As Long, m As Long
    Rem إيقاف اهتزاز الشاشة لتسريع الكود
    Application.ScreenUpdating = False
        Rem تعيين ورقة العمل التي يتم ترحيل البيانات منها
        Set ws = ThisWorkbook.Worksheets("seerr")
        Rem تعيين ورقة العمل التي يتم ترحيل البيانات إليها
        Set sh = ThisWorkbook.Worksheets("Rsd")
        Rem تحديد رقم آخر صف به بيانات بناءً على العمود الثالث في ورقة البيانات
        lr = ws.Cells(Rows.Count, "C").End(xlUp).Row
        Rem حلقة تكرارية من الصف الخامس لآخر صف به بيانات وبتخطي 4 صفوف
        For r = 8 To lr Step 4
            Rem استخدام المتغير كعداد ويزيد في كل مرة بمقدار واحد
            m = m + 1
            Rem وضع المسلسل في أول عمود في المصفوفة
            a(m, 1) = m
            Rem وضع رقم الجلوس في العمود الثاني في المصفوفة
            a(m, 2) = ws.Cells(r, 2).Value  'Seat Number
            Rem وضع اسم الطالب في العمود الثالث في المصفوفة
            a(m, 3) = ws.Cells(r, 3).Value  'Student Name
            Rem وضع درجة الطالب في العمود الرابع في المصفوفة
            a(m, 5) = ws.Cells(r, 5).Value  'Mark
            a(m, 6) = ws.Cells(r, 6).Value
            a(m, 7) = ws.Cells(r, 7).Value
            a(m, 8) = ws.Cells(r, 8).Value
            a(m, 9) = ws.Cells(r, 9).Value
            a(m, 10) = ws.Cells(r, 10).Value
            a(m, 11) = ws.Cells(r, 11).Value
            a(m, 12) = ws.Cells(r, 12).Value
            a(m, 13) = ws.Cells(r, 13).Value
            a(m, 14) = ws.Cells(r, 14).Value
            a(m, 15) = ws.Cells(r, 15).Value
            a(m, 16) = ws.Cells(r, 16).Value
            a(m, 17) = ws.Cells(r, 17).Value
            a(m, 18) = ws.Cells(r, 18).Value
            a(m, 19) = ws.Cells(r, 19).Value
            a(m, 20) = ws.Cells(r, 20).Value
            a(m, 21) = ws.Cells(r, 21).Value
            a(m, 22) = ws.Cells(r, 22).Value
            a(m, 23) = ws.Cells(r, 23).Value
            '  a(m, 24) = ws.Cells(r, 24).Value
            '  a(m, 25) = ws.Cells(r, 25).Value
            a(m, 24) = ws.Cells(r, 26).Value
          '  a(m, 25) = ws.Cells(r, 27).Value
            a(m, 26) = ws.Cells(r, 27).Value
           ' a(m, 27) = ws.Cells(r, 29).Value
            a(m, 28) = ws.Cells(r, 29).Value
          '   a(m, 29) = ws.Cells(r, 31).Value
        Rem الانتقال للمجموعة التالية بعد تخطي 4 صفوف
        Next r
        Rem بدء التعامل مع الخلية في ورقة العمل التي سيتم ترحيل البيانات إليها
        With sh.Range("A10")
            Rem مسح النطاق بدايةً من الخلية وبامتداد 4 أعمدة مع استثناء أول 9 صفوف
            .Resize(Rows.Count - 9, 29).ClearContents
            Rem وضع نتائج المصفوفة في ورقة العمل الهدف
            .Resize(UBound(a, 1), UBound(a, 2)).Value = a
        End With
    Rem استرجاع خاصية اهتزاز الشاشة في نهاية الكود
    Application.ScreenUpdating = True
End Sub
MjIyOTcx1
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  ترحيل خلايات متعدده.rar   تحميل rar مرات التحميل :(10)
الحجم :(78.701) KB


27-07-2020 07:22 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif ترحيل اعمدة وخلايا متعددة
وعليكم السلام
المطلوب غير واضح بالنسبة لي ..ممكن مزيد من التفاصيل

27-07-2020 07:25 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif ترحيل اعمدة وخلايا متعددة
بشكل مبدئي أعتقد أنك قمت بتغيير رقم الصف البداية من 5 إلى 8 لذا الأفضل وضع السطر بهذا الشكل
 For r = 5 To lr Step 4

وللحصول على الدرجة من الصف الثامن على سبيل المثال تقوم بزيادة المتغير بمقدار 3 بهذا الشكل كمثال
a(m, 5) = ws.Cells(r + 3, 5).Value

27-07-2020 07:49 مساء
مشاهدة مشاركة منفردة [3]
نصر الإيمان
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 15-02-2018
رقم العضوية : 4397
المشاركات : 446
الجنس : ذكر
تاريخ الميلاد : 29-12-1985
يتابعهم : 8
يتابعونه : 4
قوة السمعة : 885
 offline 
look/images/icons/i1.gif ترحيل اعمدة وخلايا متعددة
سلمت يداك من كل سوء  استاذ ياسر ربنا يبارك فيك
طيب حضرتك لو عملية الترحيل من العكس.....
من الرصد .....للشيت

27-07-2020 08:32 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif ترحيل اعمدة وخلايا متعددة
يفضل طرح موضوع جديد بالنقطة التي تريدها مع وضع كافة التفاصيل وملف مرفق ليستطيع الأعضاء مساعدتك إن شاء الله
والحمد لله الذي بنعمته تتم الصالحات




الكلمات الدلالية
ترحيل ، اعمده ، وخلايا ، متعدده ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 07:12 مساء