[ مساعدة ] استخراج الحقول ذات القيم بالترتيب وتجاهل الخلايا الفارغة

[لعيونك]

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

 

لدي هذا الجدول:

المجموع	تفاح	برتقال	موز	مشمش	بطيخ	عنب	كمثرى
20		4	7		9
10	3			3		4
8		6			2
17			10			7

 

وأريد أن أستخرج العدد الأول ونوعه ثم العدد الثاني ونوعه ثم الثالث ونوعه

كما في الجدول التالي:

العدد	نوع الفاكهة	العدد الثاني	نوع الفاكهة	العدد الثالث	نوع الفاكهة	المجموع
4	برتقال	7	موز	9	بطيخ	20

=INDEX(L$6:R$6,MATCH(TRUE,INDEX(L6:R6<>0,),0))

وصلح الحال مع العدد الأول

 

المشكلة في العدد الثاني كيف استخرجه مع تجاهل العدد الأول الذي استخرجته سابقاً وهكذا

مرفق الجداول

 

سؤال خارج الموضوع: هل يوجد مكتبة دوال مع شرحها باللغة العربية؟؟

المشكلة التي تواجهني دائماً ،، لا أعرف أي دالة يفترض أن أستخدمها أو أتعلمها فيما أريد.

جزاكم الله عنا خير الجزاء

Book1.zip

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

أخي الكريم هل تريد الحل بالمعادلات وفقط أم ان هناك إمكانية للحل بالأكواد؟

 

[لعيونك]

شكراً أستاذ ياسر

يفضل المعادلات، وإن لم يمكن فالكود يكفي

جزاك الله خيراً

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

إذاً ننتظر الحلول بالمعادلات أولاً وإذا لم توجد فسنحاول إن شاء الله عمل كود يقوم بالمهمة

[لعيونك]

شكراً لدعمك أستاذ ياسر

[لعيونك]

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

أعتقد أن الأخ مختار حسين سيحاول تقديم حل لك إن شاء الله .. وفي انتظار حلول من الأخوة الكرام بالمعادلات لتمام الاستفادة

[مختار حسين محمود]

تحياتى لك أخى و حبيبى ياسر

الحل المقدم من حضرتك أكثر من رائع 

تم اضافة جمع الاصناف فى كل صف  

استفسار أستاذى الفاضل حاولت استخدام المصفوفات  فـ     كيف استخدم  المصفوفات فى حاجة زى كده  ؟
 

 

استخراج الحقول ذات القيم بالترتيب وتجاهل الخلايا الفارغة.rar

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

أخي الغالي مختار حسين

تفضل باستخدام المصفوفات

Sub Using_Arrays()
    Dim Arr         As Variant
    Dim Temp        As Variant
    Dim I           As Integer
    Dim J           As Integer
    Dim P           As Integer
    Dim Cnt         As Integer
    Dim tSum        As Double

    Range("C6:I9").ClearContents

    Arr = Range("L5:R9").Value
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1)

    For I = 2 To UBound(Arr, 1)
        Cnt = 0: tSum = 0
        For J = LBound(Arr, 2) To UBound(Arr, 2)
            If Not IsEmpty(Arr(I, J)) Then
                Temp(I - 1, Cnt + 1) = Arr(I, J)
                Temp(I - 1, Cnt + 2) = Arr(1, J)

                tSum = tSum + Arr(I, J)
                P = P + 1
                Cnt = Cnt + 2
            End If
        Next J
        Temp(I - 1, UBound(Temp, 2) - 1) = tSum
        Cnt = Cnt + 2
    Next I

    Range("C6").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp
End Sub

 

 

[مختار حسين محمود]

ما شاء الله عليك أستاذى سلمت يمينك  ابا البراء

أنا أغبطك  بجد     (  العين عليها حارس لربما حد يفتكرها حاجة تانى )     

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

1 دقيقه مضت, مختار حسين محمود said:

ما شاء الله عليك أستاذى سلمت يمينك  ابا البراء

أنا أغبطك  بجد     (  العين عليها حارس لربما حد يفتكرها حاجة تانى )     

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

(بس تعرف أحلى حاجة ايه؟! إني أول واحد أستقبلك رغم إني مش من رواد المكان باستمرار ..لكن سبحان الله شاء الله ذلك ، وما شاء الله كان)

[مختار حسين محمود]

و يشرفنى أن أكون أحد تلاميذك  لعلمك  وتواضعك    وقوة  الارادة لديك    تحياتى

[لعيونك]

ماشاء الله ، بارك الله فيكم وفي علمكم

حاولت التعديل ولم أستطع لأجعله يحسب أكثر من 3 

في حال أردت الزيادة مثلاً كيف أضيف سطر برمجي إضافي

أو إن أمكن شرح الكود أو توضيح ما هي الأرقام التي يلزمني تغييرها

الملف مرفق

try.zip

تم تعديل أكتوبر 9, 2016 بواسطه لعيونك

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

أضف ورقة عمل جديدة ثم جرب الكود التالي

Sub Using_Arrays()
    Dim Arr         As Variant
    Dim Temp        As Variant
    Dim I           As Integer
    Dim J           As Integer
    Dim P           As Integer
    Dim Cnt         As Integer
    Dim tSum        As Double

    Sheet1.Range("B3:L1000").ClearContents

    Arr = Sheet1.Range("O2:AT143").Value
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) * 2 + 1)

    For I = 2 To UBound(Arr, 1)
        Cnt = 0: tSum = 0
        For J = LBound(Arr, 2) To UBound(Arr, 2)
            If Not IsEmpty(Arr(I, J)) Then
                Temp(I - 1, Cnt + 1) = Arr(I, J)
                Temp(I - 1, Cnt + 2) = Arr(1, J)

                tSum = tSum + Arr(I, J)
                P = P + 1
                Cnt = Cnt + 2
            End If
        Next J
        Temp(I - 1, UBound(Temp, 2) - 1) = tSum
        Cnt = Cnt + 2
    Next I

    Sheet2.Range("A1").Resize(UBound(Temp, 1), J * 2 - 1).Value = Temp
End Sub

ستوضع النتائج في ورقة العمل الجديدة

والمجموع في العمود رقم 64 في الورقة الجديدة

[لعيونك]

بارك الله فيكم

بقي أنه لما ينسخ للورقة الجديدة لا ينسخ عمود الأسماء (Name01, Name02) ليتم الربط بين الأسماء والأرقام

هل بالإمكان إضافة الأسماء كعمود أول قبل سحب القيم

 

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

تفضل أخي الكريم الملف التالي عله يفي بالغرض إن شاء المولى

رابط الملف المرفق من هنا

[لعيونك]

بارك الله فيكم، والله إني لمحرج لإكثاري عليكم

رجاء أخير، هل بالإمكان تجاهل القيم التي تساوي 0

[عبدالله المجرب]

السلام عليكم 

تمكن قوي في المصفوفات وعمل قمة في الروعة 

بس اي استفسار وطلب

 

الاستفسار هو 

ما فائدة هذا السطر 

P = P + 1

اما الطلب 

 

فهو شرح مفصل لطريقة عمل المصفوفة في الكود 

 

وشكراً من القلب

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

وعليكم السلام أخي الحبيب عبد الله

الوقت لا يسعني الآن للشرح وإن شاء الله إذا تيسر لي الوقت سأحاول الشرح ..

قمت بعمل حلقة تكرارية كمرحلة مبدئية في أول الكود حيث تم استخدام المتغير P لمعرفة عدد الأرقام التي سيتم التعامل معها في كل صف من صفوف المصفوفة

وبعد الانتهاء من الحلقة التكرارية يتم عقد مقارنة بين المتغير P ومتغير آخر باسم Counter فإذا كان الأول أكبر من الثاني فإن المتغير Counter يساويه في هذه الحالة

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

ويتم ضرب المتغير Counter * 2 وذلك لأن كل رقم مرتبط بالعنوان الخاص به في أول صف للمصفوفة ..إذاً كل رقم سيوضع في عمودين عمود للرقم والآخر للعنوان المرتبط به

[لعيونك]

 

 

بارك الله فيكم وجازاكم عنا بالخيرات شكرا وعرفانا 

 

 

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

الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير

تقبل تحياتي