توزيع رقم

[عطية23]

الملف المرفق به شرح المطلوب ارجو المساعدة لو امكن

توزيع رقم.xls

[lionheart]

Try this udf

Function DistributeNumber(ByVal num As Long, ByVal chunks As Long)
    Dim i As Long
    ReDim b(chunks - 1)
    For i = 0 To chunks - 1
        If i = chunks - 1 Then
            b(i) = num
        Else
            b(i) = WorksheetFunction.RoundUp(num / (chunks - i), 0)
            num = num - b(i)
        End If
    Next i
    DistributeNumber = b
End Function

The udf can be used as formula

=TRANSPOSE(DistributeNumber(13,5))

 

[عطية23]

استادى العزيز العدد او الرقم مطلوب تقسيمه على خمس دفعات كما بالامثلة ولكن بطريق ان يكون بالتساوى ولكن لو الكان الرقم لا يقسم بالتساوي الزبادة توزع من البداية مثال 13 تقسم كالاتى 3 ثم3 ثم 3 ثم 2 ثم 2 وهكذا اي رقم او عدد

[lionheart]

Not sure what is the problem now

Try the solution first and tell me if there is a problem in distribution and use images please

[عطية23]

استاذى الفاضل هذا الملف بعد التطبيق وهو لا يفى بالمطلوب اوبما اريد  واسف لاستخدمى ملف وليست صور

واكرر لوكان الرقم 13 يقسم الى 5 اجزاء  3/3 / 2/3 /2

3

3

3

2

2

وهكذا اي رقم ولك جزيل الشكر على اهتمامك

توزيع رقم.xls

[lionheart]

It works well at my side

Have a look

 

May be the problem is that I have a new version of excel (office 365)

paste the code and press Ctrl + G to see the results in the immediate window
 

Sub Test()
    Dim a, e
    For Each e In Array(7, 10, 13)
        a = DistributeNumber(Val(e), 5)
        Debug.Print Join(a, "-")
    Next e
End Sub

Function DistributeNumber(ByVal num As Long, ByVal chunks As Long)
    Dim i As Long
    ReDim b(chunks - 1)
    For i = 0 To chunks - 1
        If i = chunks - 1 Then
            b(i) = num
        Else
            b(i) = WorksheetFunction.RoundUp(num / (chunks - i), 0)
            num = num - b(i)
        End If
    Next i
    DistributeNumber = b
End Function

 

[محمد هشام.]

حل اخر ادا لم يكن عندك مانع في طريقة ترتيب التوزيع

Sub Dis_numbers()

Dim rng    As Range
Dim rng2   As Range
Dim cell   As Range
    
    'الخلايا المستهدفة
    
    Set rng = Range("I3,F3,C3,N12")
        
    For Each cell In rng
        Set rng2 = Range(cell.Offset(1, -1), cell.Offset(4, -1))
        rng2.Value = Int(cell.Value / 5)
        cell.Offset(0, -1).Value = cell.Value - Application.WorksheetFunction.Sum(rng2)
        
    Next cell
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''حدث ورقة 1'''''''''''''''''''
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Row Number
    If Target.Row = 3 Then Exit Sub
    Select Case Target.Column
'Columns
            Case 3, 6, 9
    Call Dis_numbers
 End Select
    
'   Cell N12
 'Column ("N")

 If Target.Row = 12 Then Exit Sub
Select Case Target.Column
      Case 14
    Call Dis_numbers
End Select
    
End Sub

 

توزيع رقم 3.xlsb

تم تعديل يونيو 9, 2023 بواسطه Mohamed Hicham

[عطية23]

عزيزى محمد هشام بداية موفقة

لكن المطلوب هو مثلاً العدد 27 تم تقسيمه الى

7

5

5

5

5

المطلوب ان يكون

6

6

5

5

5

لوكان العدد 28

6

6

6

5

5

وهكذا والشكر لك وللاخ قلب الاسد على الاهتمام

[lionheart]

Here's a modified udf to be compatible with older versions of excel

Function DistributeNumber(ByVal num As Long, ByVal chunks As Long, ByVal iIndex As Long)
    Dim i As Long
    ReDim b(chunks - 1)
    For i = 0 To chunks - 1
        If i = chunks - 1 Then
            b(i) = num
        Else
            b(i) = WorksheetFunction.RoundUp(num / (chunks - i), 0)
            num = num - b(i)
        End If
    Next i
    On Error Resume Next
        DistributeNumber = b(iIndex - 1)
        If Err.Number <> 0 Then DistributeNumber = vbNullString: Err.Clear
    On Error GoTo 0
End Function

 

you can use the udf as formula (but you will have to drag the formula)

Say the number is K1 so the formula in cell K2 should be

=DistributeNumber(K$1,5,ROW(A1))

Drag the formula down to get the results

[عطية23]

اسف على تعب حضرتك وجزاك الله خيراً

لكن الوظيفة الاضافية لا تعمل الا على الصف الاول المطلوب ان تعمل على اي صف

يعنى لو وضعت العدد في الخلية k22 بدلاً من الخلية k1 تعمل الوظيفة الاضافية ارجو ان اكون واضح في طلبى

[lionheart]

Not clear at all

You can modify the formula by changing the cell reference

[عطية23]

الف مليون شكر

اشتغلت بفضل الله

واسف انى ارهقت حضرتك