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

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


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





ترحيل الجدول وتقسيمة الى جدولين

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


موضوع مغلق


29-08-2020 10:18 مساء
محمد النيل
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-10-2017
رقم العضوية : 1282
المشاركات : 153
الجنس : ذكر
تاريخ الميلاد : 0-4-1978
الدعوات : 1
يتابعهم : 8
يتابعونه : 5
قوة السمعة : 250
 offline 


السلام عليكم ورحمتة الله وبركاتة
كل عام وانت بالف خير
ترحيل الجدول وتقسيمة الى جدولين (اي ينقسم الجدول 100 تسلسل الى الجدول الاول من 1الى 50والجدول الثاني من 51 الى 100)
ممكنmodule
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  تجربة1.rar   تحميل rar مرات التحميل :(4)
الحجم :(11.938) KB



أفضل إجابة مقدمة من salim وهي:
جرب هذا الكود

Option Explicit

Sub One_to_Two()
Dim Ro%, x%
Dim Rg_J As Range, Rg_p As Range
Set Rg_J = Range("j1").CurrentRegion
Set Rg_p = Range("P1").CurrentRegion
 If Rg_J.Rows.Count > 1 Then _
 Rg_J.Offset(1).Resize(Rg_J.Rows.Count - 1).ClearContents
 If Rg_p.Rows.Count > 1 Then _
 Rg_p.Offset(1).Resize(Rg_p.Rows.Count - 1).ClearContents
 Ro = Cells(Rows.Count, 1).End(3).Row - 1
 x = Ro / 2

 Range("j2").Resize(x, 5).Value = _
 Range("A2").Resize(x, 5).Value

 Range("P2").Resize(Ro - x, 5).Value = _
 Range("A" & x + 2).Resize(Ro - x, 5).Value
 
End Sub


الملف مرفق
عرض الإجابة




29-08-2020 10:21 مساء
مشاهدة مشاركة منفردة [1]
محمد النيل
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-10-2017
رقم العضوية : 1282
المشاركات : 153
الجنس : ذكر
تاريخ الميلاد : 0-4-1978
الدعوات : 1
يتابعهم : 8
يتابعونه : 5
قوة السمعة : 250
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
لكم الف تحية وتقدير113

29-08-2020 10:58 مساء
مشاهدة مشاركة منفردة [2]
محمد الدسوقى
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 827
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 79
يتابعهم : 9
يتابعونه : 766
قوة السمعة : 8651
عدد الإجابات: 8
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
جرب الملف التالى فيه المطلوب إن شاء الله
تم عمل الكود على اعتبار البيانات الكلية 100 فقط وتم نسخها قسمين فى الجدول المطلوب
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
 
  Test_MD.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(21.093) KB


29-08-2020 11:59 مساء
مشاهدة مشاركة منفردة [3]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
جرب هذا الكود

Option Explicit

Sub One_to_Two()
Dim Ro%, x%
Dim Rg_J As Range, Rg_p As Range
Set Rg_J = Range("j1").CurrentRegion
Set Rg_p = Range("P1").CurrentRegion
 If Rg_J.Rows.Count > 1 Then _
 Rg_J.Offset(1).Resize(Rg_J.Rows.Count - 1).ClearContents
 If Rg_p.Rows.Count > 1 Then _
 Rg_p.Offset(1).Resize(Rg_p.Rows.Count - 1).ClearContents
 Ro = Cells(Rows.Count, 1).End(3).Row - 1
 x = Ro / 2

 Range("j2").Resize(x, 5).Value = _
 Range("A2").Resize(x, 5).Value

 Range("P2").Resize(Ro - x, 5).Value = _
 Range("A" & x + 2).Resize(Ro - x, 5).Value
 
End Sub


الملف مرفق
 
 
  tajriba.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(38.377) KB


29-08-2020 11:59 مساء
مشاهدة مشاركة منفردة [4]
محمد النيل
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-10-2017
رقم العضوية : 1282
المشاركات : 153
الجنس : ذكر
تاريخ الميلاد : 0-4-1978
الدعوات : 1
يتابعهم : 8
يتابعونه : 5
قوة السمعة : 250
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
اهلا بيك استاذ
محمد الدسوقى

بارك الله بك ... للامانة كل اعمالي طيبة من خلال الاب الروحي نعم الاب الروحي فعلا

محمد الدسوقى

شكرا جزيلا جزاك الله خير ياطيب81

30-08-2020 12:00 صباحا
مشاهدة مشاركة منفردة [5]
محمد النيل
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-10-2017
رقم العضوية : 1282
المشاركات : 153
الجنس : ذكر
تاريخ الميلاد : 0-4-1978
الدعوات : 1
يتابعهم : 8
يتابعونه : 5
قوة السمعة : 250
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
جزاك الله الف خير استاذنا salim

30-08-2020 06:15 صباحا
مشاهدة مشاركة منفردة [6]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif ترحيل الجدول وتقسيمة الى جدولين
استاذ محمد 
لا ارى اي فائدة من استعمال الامر Select  عدة مرات
مما يرهق البرنامج دون اي جدوى (اذا كانت البيانات كبيرة ومتكررة) 
يكفي هذا الكود

Sub Tarheel()
Application.ScreenUpdating = False
  With ActiveSheet
    .Range("J2:N51").ClearContents
    .Range("P2:T51").ClearContents
    .Range("A2:E51").Copy
    .Range("J2").PasteSpecial (12)
' --------------------------------------
    .Range("A52:E101").Copy
    .Range("P2").PasteSpecial (12)
     Application.CutCopyMode = False
     
  End With
  
Application.ScreenUpdating = True
End Sub


 



الكلمات الدلالية
ترحيل ، الججول ، وتقسيمة ، جدولين ،


 










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

الساعة الآن 08:20 مساء