تقسيم الاسماء الى مجموعات

[haiderkh]

شكري مقدما لكم احبتي لدي 40 اسم ولدي عدد مجموعات غير ثابت المطلوب تقسيم عدد الطلاب علي عدد المجموعات واظهار الاسماء اسفل خانة المجموعات  وأقصد بها المجموعة 1 والمجموعة 2 وهكذا........

وفي المثال المرفق نموذج يوضح ذلك

 

 

111.xlsm

[ابراهيم الحداد]

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

استخدم الكود التالى

Sub DistGroups()
Dim ws As Worksheet, LR As Long
Dim i As Integer, j As Integer
Dim n As Integer, x As Integer, y As Integer
Dim p As Integer, s As Integer
Set ws = Sheets("ورقة1")
Application.ScreenUpdating = False
Range("F2:I" & Range("F" & Rows.Count).End(xlUp).Row + 1).ClearContents
LR = ws.Range("B" & Rows.Count).End(xlUp).Row
x = WorksheetFunction.CountA(ws.Range("B2:B" & LR))
n = ws.Range("D2").Value
y = Int(x / n)
z = x Mod n
If z > 0 Then
n = n + 1
Else
n = n
End If
p = 2
Do While p <= LR
For i = 1 To n
For j = 1 To y
s = j + ((i - 1) * y) + 1
If p = s Then
ws.Cells(j + 1, i + 5) = ws.Cells(p, 2)
End If
Next
Next
p = p + 1
Loop
Application.ScreenUpdating = True

End Sub

 

[Ali Mohamed Ali]

تفضل تم وضع كود الأستاذ ابراهيم بملفك وربطه بالزر

 

111.xlsm

[haiderkh]

شكرا استاذ تحياتي