مجموعة خلايا تحقق مجموع رقم معين

[توكل]

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

الإخوة الأكارم:

 

لدي في العمود B مجموعة من الأرقام وأريد معرفة الخلايا التي تحقق مجموع معين مثلاياً هل يمكن تحديد الخلايا التي يمكن أن يكون مجموعها "14006.559"  طبعاً هذا الرقم موجود في العمود B وهو متحقق فعلاً والخلايا تكون متسلسلة خلف بعضها.

فهل هناك كود أو معادلة تحقق المطلوب>

 

مع الشكر

 

SUM.rar

SUM.rar

[ياسر خليل أبو البراء]

الطلب غير واضح يرجى إرفاق بعض النتائج المتوقعة

[توكل]

شكراً لتفاعلك أخي الكريم تم إرفاق ملف يشرح المطلوب وجزاك الله خير الجزاء

SUM.rar

[طارق محمود]

السلام عليكم

تفضل أخي 

جرب الكود التالي

Sub dataselect()
T = [D21] ' Target Number
[B:B].Interior.ColorIndex = xlNone
LR = [B99999].End(xlUp).Row
For r = 2 To LR - 1
    Sm = Cells(r, 2)
    For j = r + 1 To LR
        Sm = Sm + Cells(j, 2)
        If Sm > T Then GoTo 10
        If Sm = T Then GoTo 20
    Next j
10
Next r
Exit Sub
20
Range(Cells(r, 2), Cells(j, 2)).Interior.ColorIndex = 4
Cells(r, 3).Select
MsgBox "Rows from " & r & " to: " & j
End Sub

وهذا المرفق به الكود

 

SUM.rar

[توكل]

أستاذ طارق جزاك الله خيراً وجعل ذلك في ميزان حسناتك، فعلاً هذا هو المطلوب

 

كل الشكر لمن تفاعل معنا والشكر موصول لجميع الأحبة

[ياسر خليل أبو البراء]

الأخ الكريم توكل

يوجد أسفل كل مشاركة من المشاركات كلمة "تحديد كأفضل إجابة"

يرجى تحديد المشاركة الخاصة بالباشمهندس طارق كأفضل إجابة ليظهر الموضوع مجاب

[توكل]

الأخ الكريم توكل

يوجد أسفل كل مشاركة من المشاركات كلمة "تحديد كأفضل إجابة"

يرجى تحديد المشاركة الخاصة بالباشمهندس طارق كأفضل إجابة ليظهر الموضوع مجاب

كل الشكر لك أخي ياسر

[ياسر خليل أبو البراء]

هذه محاولة أخرى إثراءاً للموضوع

Sub ColorSumRange()
    Dim I As Long, J As Long, LR As Long, SumVal As Double, rSum As Double
    SumVal = Range("D21").Value
    LR = Cells(Rows.Count, 2).End(xlUp).Row
    Columns("B:B").Interior.Color = xlNone
    
    For I = 2 To LR
            rSum = Cells(I, 2)
            For J = I + 1 To LR
                    rSum = rSum + Cells(J, 2)
                    If rSum = SumVal Then
                            Range(Cells(I, 2), Cells(J, 2)).Interior.ColorIndex = 4
                            Exit Sub
                    ElseIf rSum > SumVal Then
                            Exit For
                    End If
            Next J
    Next I
End Sub

تقبل تحياتي

[ياسر خليل أبو البراء]

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

 

في الملف المرفق إمكانية لاستخراج كل احتمالات الجمع داخل النطاق ..

Extract Possible SUMs.rar

[توكل]

ما شاء الله شكراً لتفاعلكم أخي الحبيب، ولكن في بعض الأحيان الماكرو لا يعمل بسبب إختلاف بسيط في المنازل العشرية فهل هناك حل للتقريب لأقرب منزلة

[ياسر خليل أبو البراء]

اطرح مثال تطبيقي لأفهم المطلوب ..أخي الحبيب توكل

ينبغي تحديد شكل الأرقام المقربة اضرب مثال بأي أرقام .. والتقريب المطلوب لفهم تلك النقطة

[طارق محمود]

السلام عليكم
بعد إذن أخي الحبيب / ياسر
أنا فهمت المقصود

أخي الكريم / توكل
يمكنك إضافة دالة التقريب لرقمين عشريين مثلا في ثلاث مواضع في الكود كالتالي

Sub dataselect()
T = Round([D21], 2) ' Target Number        1
[B:B].Interior.ColorIndex = xlNone
LR = [B99999].End(xlUp).Row
For r = 2 To LR - 1
    Sm = Cells(r, 2)
    For j = r + 1 To LR
        Sm = Sm + Cells(j, 2)
        If Round(Sm, 2) > T Then GoTo 10   '2
        If Round(Sm, 2) = T Then GoTo 20   '3
    Next j
10
Next r
Exit Sub
20
Range(Cells(r, 2), Cells(j, 2)).Interior.ColorIndex = 4
Cells(r, 3).Select
MsgBox "Rows from " & r & " to: " & j
End Sub

وهي طبعا 

Round(X, 2) 

حيث X هو الرقم المراد تقريبه

كما لاحظت المواضع الثلاثة هي:

T = Round([D21], 2) ' Target Number        1
..
..
..
..
If Round(Sm, 2) > T Then GoTo 10   '2
If Round(Sm, 2) = T Then GoTo 20   '3

[توكل]

ما شاء الله عليك أستذنا الكبير الأستاذ طارق المطلوب كما أردته

 

كل الشكر للأستاذ أبي البراء زادكم الله فضلاً وعلمنا مما علمكم.

[CFAMURAD]

اشكركم جميعا . ولكن يبدو انني لم استطع ايصال المطلوب بصورة صحيحيه

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

لنفترض عندي الارقام التالية (13,2,17,4,5)

اريد معادلة تعطيني الارقام التي تحقق رقم (ليس بضرورة مطابق للرقم و انما اقرب ما يكون للرقم)  

 يعني مثلا اريد مجموعه تحقق رقم 33

يطلع النتاتج (,2,13,17)