عاشق الاكسيل قام بنشر يونيو 27 مشاركة قام بنشر يونيو 27 السلام عليكم ورحمة الله وبركاته لو سمحت لو عندى مثلا 10 ارقام فى عمود معين فرضا من A1:A10 على سبيل المثال بالترتيب 5 - 9 - 16 -58 - 2- 6 - 8 - 90 -4 -10 ومثلا عاوز اعرف مجموع مين من الارقام دى يساوي رقم فى خلية تانية وليكن 60 فيبقي مثلا 2 و 58 او مثلا 34 يبقى 5 -9 - 2 -6 -8 -4 في طريقة تحقق ده بحيث يتم تظليل او تحديد القيم المطلوبة رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 29 مشاركة قام بنشر يونيو 29 وعليكم السلام ورحمة الله تعالى وبركاته اعتقد اخي الفاضل ان انسب طريقة لدالك هي استخراج القيم التي يساوي مجموعها القيمة المدخلة في عمود مغاير لان الاعتماد على التظليل ممكن يسبب لك تداخل في النتائج المتوقعة عند تواجد نفس الرقم في اكثر من احتمال مثال لو اردنا استخراج الاعداد الخاصة ب 34 مع وجود الارقام التي قمت بدكرها في مشاركتك سنعثر على نفس الارقام مكررة في اكثر من احتمال 👇 لتتفادى هدا ممكن استخدام الدالة التالية مثال لعملية استخراج القيم المتوقعة 👈 لنفترض ان الخلية المخصصة لادخال المجموع هي B2 In cell B2 =IFERROR(TRANSPOSE(xFormula(A2:A11; B2));"") وفي Module انسخ الكود التالي مع حفظ الملف بصيغة الماكرو Option Explicit '================29/06/2024 by:MOHAMEED HICHAM www.officena.net "منتدى الاكسيل" ' '=========================================================================================== Public Function xFormula(rngNumbers As Range, XSum As Long) Dim arNumbers() As Long, tmp() As Long, arr() As String, F As Range, Cnt As Long ReDim arr(0) If rngNumbers.Count > 1 Then ReDim arNumbers(rngNumbers.Count - 1) Cnt = 0 For Each F In rngNumbers arNumbers(Cnt) = CLng(F.Value) Cnt = Cnt + 1 Next F Call Cpt(arNumbers, XSum, tmp(), arr()) End If ReDim Preserve arr(0 To UBound(arr) - 1) xFormula = arr End Function Private Sub Cpt(Numbers() As Long, target As Long, tmp() As Long, ByRef arr() As String) Dim s As Long, i As Long, j As Long, num As Long Dim Rng() As Long, tmpRec() As Long, n As Long s = a(tmp) If s = target Then n = UBound(arr) ReDim Preserve arr(0 To n + 1) arr(n) = b(tmp) End If If s > target Then Exit Sub If (Not Not Numbers) <> 0 Then For i = 0 To UBound(Numbers) Erase Rng() num = Numbers(i) For j = i + 1 To UBound(Numbers) Total Rng, Numbers(j) Next j Erase tmpRec() C tmpRec, tmp Total tmpRec, num Cpt Rng, target, tmpRec, arr Next i End If End Sub Private Function b(x() As Long) As String Dim n As Long, result As String result = " " & x(n) For n = LBound(x) + 1 To UBound(x) result = result & "-" & x(n) Next n result = result & " " b = result End Function Private Function a(x() As Long) As Long Dim n As Long a = 0 If (Not Not x) <> 0 Then For n = LBound(x) To UBound(x) a = a + x(n) Next n End If End Function Private Sub Total(arr() As Long, x As Long) If (Not Not arr) <> 0 Then ReDim Preserve arr(0 To UBound(arr) + 1) Else ReDim Preserve arr(0 To 0) End If arr(UBound(arr)) = x End Sub Private Sub C(destination() As Long, source() As Long) Dim n As Long If (Not Not source) <> 0 Then For n = 0 To UBound(source) Total destination, source(n) Next n End If End Sub ادا كنت تستخدم النسخ الحديثة من الاوفيس ضع المعادلة التالية في الخلية E2 للتحقق من مجموع القيم المستخرجة مع سحبها للاسفل =IF(D2<>"";SUM(FILTERXML("<x><y>"&SUBSTITUTE(TRIM(CONCAT(IFERROR(0+MID(D2;SEQUENCE(LEN(D2));1);" ")));" ";"</y><y>")&"</y></x>";"//y"));"") فحص مجموعة قيم لايجاد اى منها يساوى قيمة معينة.xlsm 2 رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر يوليو 2 مشاركة قام بنشر يوليو 2 ممتاذ احسنت استاذ / محمد هشام رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.