المطلوب دالة تبحث عن المبلغ والمدة بشرط

[الشافعي]

السلام عليكم

مبارك عليكم الشهر 

اذا تكرمتوا مطلوب دالة تبحث عن المبلغ وعن المدة في الجدول رقم ١ وحسب كل مبلغ وكل مدة تضعها القيمة والمدة في الجدول رقم ٢ 

مرفق ملف يوضح المطلوب 

وجزاكم الله الف خير 

Book2.xlsx

[الشافعي]

للرفع 

دالة او كود 

[Foksh]

في 9‏/3‏/2025 at 03:47, الشافعي said:

اذا تكرمتوا مطلوب دالة تبحث عن المبلغ وعن المدة في الجدول رقم ١ وحسب كل مبلغ وكل مدة تضعها القيمة والمدة في الجدول رقم ٢ 

 

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

طلبك يا صديقي غير واضح ، فما هي الشروط التي على أساسها سيتم تحديد القسط والمدة ( الشرط الذي على أساسه سيتم تحديد نوع الإلتزام  )  ؟؟

لنفترض في السجل رقم 50 ، كيف سيتم تحديد القيم التي تريد جلبها وأين تريد إضافة المدة ( في أي خلية ) اذا اعتمدنا ان MAX Installment limit = قيمة القسط على سبيل المثال .

[الشافعي]

القسط الأول يبدء من الشهر رقم واحد ومدة حتي نهاية القسط الأول 

القسط الثاني  يبدء عن تغيير رقم القسط الأول ومدته من نهاية القسط الأول الي تغيير رقم القسط الثاني 

وهكذا 

يعني في الجدول رقم ١ 

القسط يمثل  MAX Installment limit وعدد الاقساط يمثل NO
يبدء القسط الأول من الشهر رقم ١ وحسب الجدول يكون مثلا ٨٣٠٠ وينتهي عن الشهر ٧٧

القسط رقم يبدء عن تغير الرقم ٨٣٠٠ وهيتغير في الشهر ٧٨ ويكون ٧٣٠٠ وينتهي عند الشهر ٨٨ يعني مدته ١١ شهر 

 

 

الشرط القسط يبدء من الشهر رقم ١ وكل ما يتغير القسط ينقل القسط هذا في الجدول رقم ٢ ويحسب مدته ويضعه في الجدول رقم ٢ 

 

 

اتمني ان يكون وصل فكرتي ولو في رقم للتواصل ممكن اتصل عليك واعتذر الموضوع مطلوب في العمل ومهم جدا 

الله يجعله في ميزان حسانتكم 

[محمد هشام.]

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

جرب هدا  بعد محاولة إلغاء دمج الخلايا على الجدول 2

Private Const début As Long = 7
Private Const StarRow As Long = 6
Sub Data_Extraction()
    Dim lastRow As Long, a As Long, i As Long, b As Long
    Dim tmp As Double, tbl As Double, arr As Variant, ky As Long
    
    arr = Array("الأول", "الثاني", "الثالث", "الرابع", "الخامس", "السادس")
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        .Cells(6, 13).Resize(6, 3).ClearContents
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        a = StarRow
        b = début
        tmp = .Cells(b, 5).Value
        
        For i = b + 1 To lastRow + 1
            tbl = .Cells(i, 5).Value
            If tbl <> tmp Or i = lastRow + 1 Then
                If tmp <> 0 Then
                    ky = a - StarRow
                    .Cells(a, 11).Value = i - b: .Cells(a, 12).Value = tmp
                    .Cells(a, 13).Value = "الالتزام " & arr(ky)
                    
                    a = a + 1
                End If
                b = i
                tmp = tbl
            End If
        Next i
        
        Do While a <= 11
            ky = a - StarRow
            .Cells(a, 11).Value = 0: .Cells(a, 12).Value = 0
            .Cells(a, 13).Value = "الالتزام " & arr(ky)
            a = a + 1
        Loop
    End With
    Application.ScreenUpdating = True
    MsgBox "تم استخراج الأقساط والمدد بنجاح", vbInformation
End Sub

 

Book v2.xlsb

[الشافعي]

الاستاذ / محمد هشام المحترم 

شكرا على مجهودك وتعبك والله يجزآك ألف خير 

بس إذا ممكن دالة لان الان الاكسيل هذا في أشياء كثيرة مرتبته ببعضها غير المرسلة في الكود ما راح يضبط معاي 

والف مليون شكر لتعبكم 

[الشافعي]

للرفع

[محمد هشام.]

 

6 ساعات مضت, الشافعي said:

الان الاكسيل هذا في أشياء كثيرة مرتبته ببعضها غير المرسلة في الكود ما راح يضبط معاي 

بما أن الكود المقترح لا يشتغل معك أظن أن طلبك غير واضح بالنسبة لي 

 

[الشافعي]

السلام عليكم استاذ محمد 

وجزاك الله ألف خير 

الكود صحيح ١٠٠٪؜ وجزاك الله ألف خير

بس ملف الاكسيل اللي أنا شغال عليه مش هينفع ادخل عليه أي أكواد بسبب أشياء كثيرة مرتبطة ببعضها وعمليات حسابية وتعدد الأوراق اللي في الملف المرتبطة ببعضها أنا فقط أرسلت جزء من الملف 

إذا الله يحفظك في طريقة يكون نفس الكود هذا بس معادلة 

الكود صحيح مليون في ١٠٠٪؜ وجزاك ألف خير والله يجعله في ميزان حسانتك

بس احتاج أنها تكون معادلة