السلام عليكم ورحمة الله وبركاته
بفرض أن لديك قائمة بأسماء التلاميذ وليكن عدد التلاميذ 23 وتريد تقسيم القائمة أي شطرها إلى نصفين .. في الشطر الأيمن 12 طالب وفي الأيسر 11 طالب (الكود مرن ويتعامل مع أي عدد من الأسماء أو البيانات)
ترى هل يمكن عمل ذلك بسهولة؟ >> نعم جرب الكود التالي لترى بنفسك
إليكم الكود ... يقوم الكود بتقسيم القائمة إلى شطرين بالبيانات الملحقة بها وتظهر النتائج في ورقة العمل الثانية Sheet2
Sub SplitList()
'Author : YasserKhalil
'Release : 07 - 09 - 2016
'------------------------
'تعريف المتغيرات
Dim shSource As Worksheet, shTarget As Worksheet
Dim rList As Range, rListA As Range, rListB As Range
Dim hCount As Long, tCount As Long
'عدد أعمدة النطاق المراد عمل إنشطار له
Const colNum As Integer = 3
'تعيين ورقة العمل المصدر التي تحتوي القائمة الرئيسية وورقة العمل الهدف
Set shSource = Sheets("Sheet1")
Set shTarget = Sheets("Sheet2")
'تعيين النطاق الذي يحتوي على القائمة المراد شطرها
Set rList = shSource.Range("A6:A" & shSource.Cells(Rows.Count, "A").End(xlUp).Row)
'تعيين بداية النطاق للشطر الأول من القائمة
Set rListA = shTarget.Range("A4")
'تعيين بداية النطاق للشطر الثاني من القائمة
Set rListB = rListA.Offset(, colNum)
'تعيين قيمة المتغير ليساوي عدد خلايا النطاق المصدر
tCount = rList.Cells.Count
'تعيين قيمة للمتغير ليساوي تقريب قيمة قسمة المتغير السابق ÷ 2
hCount = Application.RoundUp(tCount / 2, 0)
'مسح النطاق الذي ستظهر فيه النتائج للشطر الأول والشطر الثاني
shTarget.Range("A3").CurrentRegion.Offset(1).ClearContents
'وضع نتائج الشطر الأول
rListA.Resize(hCount, colNum).Value = Range(rList(1).Address(External:=True) & ":" & rList(hCount).Address(External:=True)).Resize(hCount, colNum).Value
'وضع نتائج الشطر الثاني
rListB.Resize(tCount - hCount, colNum).Value = Range(rList(hCount + 1).Address(External:=True) & ":" & rList(tCount).Address(External:=True)).Resize(hCount, colNum).Value
MsgBox "Done ..." & vbNewLine & "Best Regards" & Chr(10) & "YasserKhalil", 64
End Sub
إعداد / ياسر خليل أبو البراء
لله درك اختصرت الصعاب وأتيت بالسهل الممتنع بورك فيك
ردحذفأخي العزيز أبو محمد الكبير .. بارك الله فيك ومشكور على كلماتك الطيبة ومرورك الندي بالمدونة
ردحذفكود رائع كما عودتنا ..ويا سلام لو اضيف له كود للابجدة ..وآخر لتحديد نطاق الطباعة على قدر البيانات تماما ...ولكم جزيل الشكر استاذي الفاضل
ردحذفبارك الله فيك أخي الكريم أحمد
ردحذفإن شاء الله نحاول تلبية طلبك .. وإن كنت أفضل أن يكون لكل موضوع هدف واحد فقط يتم التركيز عليه