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

[رضا على]

ارجو المساعدة فى تقسيم الارقام التى تكون اكبر من 50 اللى مجموعات = 50 وادراج صفوف يعدد المجموعات

ارقام.xlsx

[lionheart]

Sub Test()
    Const iNum As Double = 50
    Dim a, t As Double, i As Long, k As Long
    Application.ScreenUpdating = False
        With ActiveSheet
            a = .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
            ReDim b(1 To UBound(a, 1) * 10, 1 To 1)
            For i = LBound(a) To UBound(a)
                k = k + 1
                If a(i, 1) <= iNum Then
                    b(k, 1) = a(i, 1)
                ElseIf a(i, 1) > iNum Then
                    t = a(i, 1)
                    Do
                        b(k, 1) = IIf(t >= iNum, iNum, t)
                        t = t - iNum
                        k = k + 1
                        If t <= iNum Then b(k, 1) = t: Exit Do
                    Loop Until t < iNum
                End If
            Next i
            .Range("E10").Resize(k, UBound(b, 2)).Value = b
        End With
    Application.ScreenUpdating = True
End Sub

 

[رضا على]

الف مليون شكر وامتنان لمجهودكم الكريم الكود جبار وهو المطلوب بالضبط

اتا اسف نسيت اسال مع الاحتفاظ بباقى الاعمدة كما بالملف

ارقام.xlsm

[lionheart]

Not clear

Explain well what is the problem now

[رضا على]

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

تعديل ارقام.xlsm