توزيع مبلغ على دفعات (بقيمة صحيحة) وبدون باقي كبير

[أحمد عمروف]

أساتذتنا الأفاضل
بعد التحية والسلام عليكم ورحمة الله وبركاته
مشكورين سيادتكم لي طلب قريب جدا في فكرته من برنامج التقسيط
ولكن
المطلوب تقسيم المبلغ (بقيمة صحيحة دون كسور) على كل دفعة من الدفعات
وهنا المشكلة
الباقي في آخر شهر تكون قيمته أكبر نوعا ما من باقي الدفعات
أرجو التكرم بالاطلاع مع التفضل بالمساعدة في التوزيع سواء (استعلام أو كود)
بحيث يكون التوزيع على كل دفعة (قيمة صحيحة) ويمكن أن يكون الفرق (واحد صحيح) بين الدفعة والتي تليها
المرفق به جدولين
الأول .. كود اسم الشخص – المبلغ المراد توزيعه – عدد الدفعات
الثاني .. كود الشخص – رقم الدفعة – قيمة التوزيع في الدفعة
ومرفق صورة لشكل التوزيع المرفوض – ونموذجين للتوزيع القبول
مع خالص الشكر والتقدير لسيادتكم

Tawzee.mdb

[Foksh]

أخي @أحمد عمروف وعليكم السلام ورحمة الله وبركاته ,,

تفضل فكرتي عليك بأسلوبين ..

 

الأول بالكود التالي من خلال توزيع المبلغ بشكلك متسلسل ، وتستطيع استدعاءه من خلال زر باسم الالة فقط :-

Sub DistributeAmounts()
    Dim db As DAO.Database
    Dim rsMain As DAO.Recordset
    Dim rsTawzee As DAO.Recordset
    Dim personID As Long
    Dim personName As String
    Dim totalAmount As Long
    Dim numDistributions As Integer
    Dim basicAmount As Long
    Dim remainingAmount As Long
    Dim i As Integer
    Set db = CurrentDb()
    Set rsMain = db.OpenRecordset("Tb_Main")
    Set rsTawzee = db.OpenRecordset("Tb_Tawzee")
    If Not rsMain.EOF Then
        rsMain.MoveFirst
        Do Until rsMain.EOF
            personID = rsMain!ID_Name
            personName = rsMain!Name_
            totalAmount = rsMain!Price_
            numDistributions = rsMain!Cou_Tawzee
            basicAmount = totalAmount \ numDistributions
            remainingAmount = totalAmount Mod numDistributions
            For i = 1 To numDistributions
                rsTawzee.AddNew
                rsTawzee!ID_Name = personID
                rsTawzee!Name_ = personName
                rsTawzee!No_Tawzee = i
                If i <= remainingAmount Then
                    rsTawzee!Price_Tawzee = basicAmount + 1
                Else
                    rsTawzee!Price_Tawzee = basicAmount
                End If
                rsTawzee.Update
            Next i
            rsMain.MoveNext
        Loop
    End If
    rsMain.Close
    rsTawzee.Close
    Set rsMain = Nothing
    Set rsTawzee = Nothing
    Set db = Nothing
    MsgBox "تم توزيع المبالغ بشكل تسلسلي بنجاح!", vbInformation
End Sub

 

الثاني بالكود التالي من خلال توزيع المبلغ بشكلك عشوائي ، وتستطيع استدعاءه أيضاً من خلال زر باسم الالة فقط :-

Sub DistributeAmountsRandomly()
    Dim db As DAO.Database
    Dim rsMain As DAO.Recordset
    Dim rsTawzee As DAO.Recordset
    Dim personID As Long
    Dim personName As String
    Dim totalAmount As Long
    Dim numDistributions As Integer
    Dim basicAmount As Long
    Dim remainingAmount As Long
    Dim i As Integer
    Dim distributions() As Long
    Dim index As Integer
    Set db = CurrentDb()
    Set rsMain = db.OpenRecordset("Tb_Main")
    Set rsTawzee = db.OpenRecordset("Tb_Tawzee")
    If Not rsMain.EOF Then
        rsMain.MoveFirst
        Do Until rsMain.EOF
            personID = rsMain!ID_Name
            personName = rsMain!Name_
            totalAmount = rsMain!Price_
            numDistributions = rsMain!Cou_Tawzee
            basicAmount = totalAmount \ numDistributions
            remainingAmount = totalAmount Mod numDistributions
            ReDim distributions(1 To numDistributions)
            For i = 1 To numDistributions
                distributions(i) = basicAmount
            Next i
            Randomize
            For i = 1 To remainingAmount
                index = Int((numDistributions * Rnd) + 1)
                distributions(index) = distributions(index) + 1
            Next i
            For i = 1 To numDistributions
                rsTawzee.AddNew
                rsTawzee!ID_Name = personID
                rsTawzee!Name_ = personName
                rsTawzee!No_Tawzee = i
                rsTawzee!Price_Tawzee = distributions(i)
                rsTawzee.Update
            Next i
            rsMain.MoveNext
        Loop
    End If
    rsMain.Close
    rsTawzee.Close
    Set rsMain = Nothing
    Set rsTawzee = Nothing
    Set db = Nothing
    MsgBox "تم توزيع المبالغ بشكل عشوائي بنجاح!", vbInformation
End Sub

 

 

Tawzee.mdb

[أحمد عمروف]

أستاذنا الكبير Foksh

كل التقدير والشكر والاحترام لسيادتكم

الفكرة رائعة وأكثر من رائعة

الحل في غاية الروعة

أكرمكم الله وسدد خطاكم .. وجعل عملكم في ميزان حسناتكم

شكرا جزيلا .. وجزاكم الله كل الخير