تحويل معادلة فلترة الصفوف بناء على اسم المندوب إلى كود برمجى VBA

[Yasser Fathi Albanna]

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

السادة الأفاضل أساتذة ومحترفى الإكسيل زملائى وأخوانى الأعزاء

مرفق شيت به معادلة تقوم بسحب بيانات معينه من شيت رئيسى به داتا كثيرة تحدث ويضاف عليها يوميا 

هذه المعادله ثقيله جدا وذلك لكثرة البيانات التى يتم إضافتها يوميا 

يرجى تحويل هذه المعادلة إلى كود برمجى بدلا من المعادلة وذلك عند إختيار الإسم من الخانه المظلله باللون الأخضر وعند الضغط على الزر البرمجى يتم سحب الداتا المطلوبة 

ويرجى عمل كود برمجى لزر البرنتر المرفق أيضا 

ولكم من خالص الشكر والتقدير والإمتنان للمساعدة 

مرفق الشيت 

 

Retails Sales Report.xlsx

[أ / محمد صالح]

أخي الكريم استعمال معادلات الصفيف في نطاق واسع يبطئ الملف جدا

وأحد الحلول لعمل تصفية بالمعادلات هي

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

وتغيير معادلة المسلسل في شيت التقرير

ومعادلة البحث في شيت التقرير

هذا ملفك بعد التعديل لإيصال الفكرة (يمكنك استكمال معادلة البحث في باقي الأعمدة)

بالتوفيق

Retails Sales Report.xlsx

[Yasser Fathi Albanna]

أستاذ ومعلمى القدير الأستاذ / محمد صالح 

معادلة وفكرة أكثر من رائعة 

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

أستأذن حضرتك هل فى إمكانيه تحويل المعادلة بالمرفق المدرج الأول إلى كود برمجى بدلا من إضافة عمود مساعد

حيث أن الداتا الموجودة بالشيت تملاء تلقائيا ومربوطة ببرنامج الشركة لعدم حدوث أى خطأ أثناء النقل 

ولكم منى وافر التقدير والإحترام

تم تعديل أغسطس 20, 2023 بواسطه Yasser Fathi Albanna

[احمد عبدالحليم]

تفضل اخى جرب هذا المف والكود للعلامة الاستاذ / ياسر العربى  (كود البحث باستخدام المصفوفات وقام بشرحه بالتفصيل العلامة الاستاذ/ ياسر خليل ابو البراء

Retails Sales Report .xlsm

[Yasser Fathi Albanna]

أخى الفاضل الأستاذ / أحمد عبد الحليم

هذا هو المطلوب بالضبط

سلمت يمينك 

كود رائع للأستاذ العلامة / ياسر العربى وأيضا أستاذ / ومعلمى القدير أخى فى الله ياسر خليل أبو البراء 

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

 

[محي الدين ابو البشر]

السلام عليكم ممكن حل آخر

Sub test()
    Dim a
    Dim i&
    a = Sheets("Form Responses 1").Cells(4, 1).CurrentRegion
    With CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
    If a(i, 3) = Cells(2, 3) Then
   If Not .exists(a(i, 3) & a(i, 1)) Then
   .Add a(i, 3) & a(i, 1), Array(a(i, 3), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 10), a(i, 15), a(i, 17), a(i, 19))
   End If: End If
    Next
    a = Application.Index(.items, 0, 0)
    End With
    With Sheets("Report").Cells(4, 2).Resize(UBound(a) - 1, 9)
        .ClearContents
        .Value = a
    End With
End Sub

 

[احمد عبدالحليم]

معذرة لم انتبه للطلب الثانى وهو الطباعة تم عمل كود الطباعة وهو للمعاينة قبل الطباعة 

Retails Sales Report .xlsm

[Yasser Fathi Albanna]

أخى وأستاذ الكريم / محي الدين ابو البشر

شكرا جزيلا لمرور حضرتك الكريم على موضوعى 

مجرد مرورك شرف لى 

كود أكثر من رائع وقمت بتجربته بالفعل ويقوم بنفس المطلوب 

شكرا جزيلا 

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

أخى الحبيب الأستاذ / احمد عبدالحليم

لا أجد من الكلمات التى تعبر عن مدى شكرى وإمتنانى لحضرتك 

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

هذا هو المطلوب بالفعل 

أدام الله فضله ونعمه وزادك من علمه

تم تعديل أغسطس 20, 2023 بواسطه Yasser Fathi Albanna

[elmansyeswa]

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