مطلوب كود

[طالب مدرسة أوفيسنا]

السلام عليكم تحيه طيبه للجميع

بإختصار بيانات يتم تصفيتها باسماء العملاء ويتم استخراج اعلى قيمة للعميل بعد التصفيه بإستخدام دالة SUBTOTAL وتعمل بشكل جيد

المطلوب استخراج تاريخ اعلى قيمة

مرفق المثال وشرح المطلوب بشكل واضح وشرح داخل الماكرو لطريقة عمله

مع الشكر

مثال.rar

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

أخي الكريم ماذا لو كان هناك أكبر القيم لعميل واحد بنفس القيمة ..أقصد مثلاً إذا قمنا بتصفية العميل وحصلنا على القيمة 10 مرتين .. ما الحل في هذه الحالة؟

 

[طالب مدرسة أوفيسنا]

الف شكر استاذنا الغالي ياسر

لامشكله الاكتفاء بالاول منها

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

تقصد الأحدث في التاريخ ؟؟ هو الأول أم الأقدم في التاريخ؟؟

حاول تكون محدد الهدف لأنه وارد ان يكون هناك أكثر من قيمة للعميل الواحد

[طالب مدرسة أوفيسنا]

الأقدم في التاريخ

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

أخي الكريم جرب الكود التالي

Sub Test()
    Dim A, I As Long, II As Long

    A = Sheets("ALL").Cells(1).CurrentRegion.Value

    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(A, 1)
            If Not .exists(A(I, 1)) Then
                .Item(A(I, 1)) = .Count + 1
                For II = 1 To UBound(A, 2)
                    A(.Count, II) = A(I, II)
                Next
            Else
                If A(I, 3) > A(.Item(A(I, 1)), 3) Then
                    For II = 2 To UBound(A, 2)
                        A(.Item(A(I, 1)), II) = A(I, II)
                    Next II
                ElseIf A(I, 3) = A(.Item(A(I, 1)), 3) Then
                    A(.Item(A(I, 1)), 2) = Application.Min(A(.Item(A(I, 1)), 2), A(I, 2))
                End If
            End If
        Next
        I = .Count
    End With

    Sheets("DATA").Cells(1).Resize(I, UBound(A, 2)).Value = A
End Sub

تقبل تحياتي

 

[طالب مدرسة أوفيسنا]

ماشاء الله كود جميل تم به المطلوب

اكرر شكري لك استاذ ياسر

 

[طالب مدرسة أوفيسنا]

استاذ ياسر هل ممكن شرح لهذا الكود

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

الكود محترف واريد فهم طريقته

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

صراحة أخي الكريم الكود يحتاج لوقت طويل جداً لشرحه ووقتي للأسف لا يسمح بذلك ..

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

فقط وضح ما تريد فعله ليسهل التعديل

[طالب مدرسة أوفيسنا]

الله يجزاك خير نعم اريد التعديل لفلترت التاريخ مثلا عام 2015 فقط

بمعنى مشتروات العميل فقط لعام واحد واستخراج الاعلى لها نفس الطريقه السابقه

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

يرجى إرفاق ملف آخر موضحاً فيه شكل النتائج المتوقعة لأن الطلب غير واضح بعض الشيء ... بالمثال دائماً يتضح المقال

تقبل تحياتي

[طالب مدرسة أوفيسنا]

تعم تعديل الكود بحيث يظهر عام 2015 على حده بشكل بطريقة بدائية

امل ان يكون واضح بالمرفقات

 

مثال.rar

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

إن شاء الله إذا تيسر لي الوقت سأقوم بالعمل عليه إلا إذا تدخل أحد الأخوة الأعضاء

تقبل تحياتي

[طالب مدرسة أوفيسنا]

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

في ١٠‏/٦‏/١٤٣٧ هـ at 17:36, ياسر خليل أبو البراء said:

 

Sub Test()
    Dim A, I As Long, II As Long

    A = Sheets("ALL").Cells(1).CurrentRegion.Value

    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(A, 1)
            If Not .exists(A(I, 1)) Then
                .Item(A(I, 1)) = .Count + 1
                For II = 1 To UBound(A, 2)
                    A(.Count, II) = A(I, II)
                Next
            Else
                If A(I, 3) > A(.Item(A(I, 1)), 3) Then
                    For II = 2 To UBound(A, 2)
                        A(.Item(A(I, 1)), II) = A(I, II)
                    Next II
                ElseIf A(I, 3) = A(.Item(A(I, 1)), 3) Then
                    A(.Item(A(I, 1)), 2) = Application.Min(A(.Item(A(I, 1)), 2), A(I, 2))
                End If
            End If
        Next
        I = .Count
    End With

    Sheets("DATA").Cells(1).Resize(I, UBound(A, 2)).Value = A
End Sub

 

 

 

[عمرو رجب]

عايز الكود عن طريق اليوزفرم