اذهب الي المحتوي
أوفيسنا

مطلوب تعديل الكود ليحقق الشكل المطلوب


الردود الموصى بها

أخي العزيز / فضل

قمت بتسجيل ماكروا آخر لعمل تصفية متقدمة بنفس الطريقة تبعك بس تم تغير النطاق كما ستلاحظ

لست أدري هل هذا هو مطلوبك أم لا

وإذاكان مطلوبك آخر فانتظر رد الخبراء

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

تعديل لكود لتحقيق المطلوب.rar

رابط هذا التعليق
شارك

السلام عليكم

اخي فضل كلمة حق احب ان اقولها لك

ما يعجبني في طلباتك انها تشعرني بالتحدي والرغبة في حلها

==

اليك هذا اللحن الجميل من اخيك المايسترو (والله وحشني ياسر الحافظ فقد اطلق علي دينمو المنتدى)


Sub Abu_Ahmed()

Application.ScreenUpdating = False

r = 9: rr = 10

MyArr = Array(100, 200, 300, 400, 500)

For i = 3 To 7

[H2] = MyArr(i - 3)

[B1:C22].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[H1:H2], CopyToRange:=Range(Cells(20, r), Cells(20, rr)), Unique:=True

r = r + 2

rr = rr + 2

Next

Application.ScreenUpdating = True

End Sub

تعديل لكود لتحقيق المطلوب.rar

رابط هذا التعليق
شارك

استاذى الفاضل / المايسترو

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

استوقفنى هذا العمل الرائع لفترة طويلة من الوقت . وقمت بتجربته على كم من البيانات كبير جدا حوالى 2900 بيان وكان الملحوظات كالاتى

1- لم يعمل الكود بشكل صحيح مع هذا الكم الكبير من البيانات الا ان بعد قمت بتغير قيمة r إلى 19 وقمت بتغيير قيمة rr إلى 20 ولااعرف ماهو السبب .

2- عمل معى الكود بشكل جيد جدا مع الكم الكبير للبيانات ولكن ترك فى وسط مخرجاته مرة واحدة كود القسم ورقم القسم خالى ولاادرى لماذا .

3- النقطة الثالثة اريد اعرف لماذا بالتحديد بدأت الحلقة التكرارية برقم 3 ولماذا مثلا لم تبدأها مثلا برقم 1

4- كانت ارقام المصفوفة لبياناتى حوالى 35 رقم هل هذا الكم الكبير من ارقام المصفوفة له تأثير على عمل الكود اى بمعنى اخر هل المصفوفة لها عدد معين من الارقام لايمكن تجاوزه .

5- الله يكون فى عون الكود فكان عند تنفيذه مع الكم الكبير كان يستهلك وقت ليس بالقصير

6- كنت اتمنى يامايسترو ان اتعامل مع range وليس cells وفى كل مره يتم تنفيذ الحلقة التكرارية على range يكون موجود امر للنسخ لهذا range ضمن الحلقة التكرارية . وبقصد للتوضيح التعامل مع range بدل من اسماء الخلايا بى cells وهنا بقصد (Cells(20, r), Cells(20, rr)), وان كنت متفهم لماذا لجئت الى التعامل للخلايا cells للتنقل .

واخيرا وهذا الاهم ياحبيبى انه بالفعل لحن مميز بل لحن دسم وقوى وبالفعل ارفع له القبعة تقديرا واجلالا لصاحب هذا العمل الجميل العظيم .

والله انا لااريد انهاء هذه المشاركة الجميلة وبالذات مع حبيب قلبى المايسترو اللى اصبحت الحانه غير عادية وقربت الحانه توصل للعالمية . الف مليون شكر وعلى فكرة انا بكون سعيد جدا جدا جدا عندما سيادتك تقوم بالرد على مشاركاتى بل لن اخفى عليك سر انا اتطوق شوقا للردك على مشاركاتى . ونتقابل قريبا فى مشاركة اخرى ان شاء الله .

رابط هذا التعليق
شارك

لم يعمل الكود بشكل صحيح مع هذا الكم الكبير من البيانات الا ان بعد قمت بتغير قيمة r إلى 19 وقمت بتغيير قيمة rr إلى 20 ولااعرف ماهو السبب .

اخي فضل وانا لا اعلم لها سببا ف r هنا تساوي رقم العمود الذي سيتم لصق البيانات فيه بعد التصفية ويمثل هنا العمود i وسيكون هو كود القسم و rr هي الععمود المجاور له ويساوي j ويمثل رقم القسم

وبعد كل حلقة تكرارية سيتم زيادة هذا الرقم بمقدار عمودين لكل من r و rr

=====

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

وهذه ايضاً ليس لها سبب معرف (فارجو منك ان ترفق لي هذه الكمية الكبيرة من البيانات للتجربة ولو على الخاص ان كان بها ما يستدعي اخفائها)

للعلم جربت الكود على 2900 بيان و35 رقم قسم ولم يحدث اي خلل

=====

النقطة الثالثة اريد اعرف لماذا بالتحديد بدأت الحلقة التكرارية برقم 3 ولماذا مثلا لم تبدأها مثلا برقم 1

كنت قد كتبت الكود دون استخدام ال Array واعتمدت على الخلايا في المدى N3:N7 واعتقد انه الان اصبح واضح السبب ويمكن ان تعدلها لتصبح


For i = 0 To 4

[H2] = MyArr(i)

====

كانت ارقام المصفوفة لبياناتى حوالى 35 رقم هل هذا الكم الكبير من ارقام المصفوفة له تأثير على عمل الكود اى بمعنى اخر هل المصفوفة لها عدد معين من الارقام لايمكن تجاوزه .

لا يؤثر وقد جربت الكود على عدد 35 حد للمصفوفة ابتداً من 100 الى 3500 ونفذ الكود في اقل من 4 ثوانٍ (يجب ان تنتبه لعدد الحلقات التكرارية ستصبح 35 حلقة)

====

الله يكون فى عون الكود فكان عند تنفيذه مع الكم الكبير كان يستهلك وقت ليس بالقصير

كما قلت لك جربت الكود (مع تعديل ما يلزم ) ولم يتجاوز عمل الكود ال 4 ثوان

====

كنت اتمنى يامايسترو ان اتعامل مع range وليس cells وفى كل مره يتم تنفيذ الحلقة التكرارية على range يكون موجود امر للنسخ لهذا range ضمن الحلقة التكرارية . وبقصد للتوضيح التعامل مع range بدل من اسماء الخلايا بى cells وهنا بقصد (Cells(20, r), Cells(20, rr)), وان كنت متفهم لماذا لجئت الى التعامل للخلايا cells للتنقل .

ما تم التعامل معه في مكان لصق البيانات بعد التصفية هو renge لكن حدود هذا المدى حسب طلبك تكون متجاورة لذا تم استخدام

Cells

====

واخيرا وهذا الاهم ياحبيبى انه بالفعل لحن مميز بل لحن دسم وقوى وبالفعل ارفع له القبعة تقديرا واجلالا لصاحب هذا العمل الجميل العظيم .

والله انا لااريد انهاء هذه المشاركة الجميلة وبالذات مع حبيب قلبى المايسترو اللى اصبحت الحانه غير عادية وقربت الحانه توصل للعالمية . الف مليون شكر وعلى فكرة انا بكون سعيد جدا جدا جدا عندما سيادتك تقوم بالرد على مشاركاتى بل لن اخفى عليك سر انا اتطوق شوقا للردك على مشاركاتى . ونتقابل قريبا فى مشاركة اخرى ان شاء الله

حياك الله اخي فضل وكما قلت لك طلباتك الجميل فيها ان تبعث فيني روح التحدي :wink2:

رابط هذا التعليق
شارك

حبيب قلبى المايسترو الكبير

ايوه كده ياحبيبى كله تمام مش بس تمام ده 1000000 تمام . لقد قمت بالتعديل المطلوب التى اوضحته For i = 0 To 4 و (H2] = MyArr(i)

والنتائج مبهرة كما هو مطلوب بالضبط .

تسلم ياحبيبى وتسلم الحانك الجميلة بل تسلم سيمفونياتك الرائعة . جمال ياحبيبى مابعده جمال وابداع مابعده ابداع . جعلتنى انا وغيرى نستمتع بالاكسل بل جعلتنا نستمتع ونحن معك يامايسترو بموسيقى والحان وجمال وفن الاكسل .

حبيب قلبى المايسترو

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

لذلك

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

فهل يمكن ان تأخذ المصفوفة ارقامها من range

اى بمعنى ان احدد للمصفوفة المدى المطلوب الذى به الارقام وفى كل مره تأخذ المصفوفة رقمها من هذا المدى تفاديا لما قلت .

فى النهاية

لايسعنى الا ارسل لك كل الاحترام والتقدير والمحبة لشخصك الكريم وعلى روح التحدى والرغبة التى تتمتع بها فى الوصول للحلول المبهرة .

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

واطلقت على هذا الملف المرفق اسم

كود من الحان المايسترو الخالدة

كود من الحان المايسترو الخالدة.rar

رابط هذا التعليق
شارك

السلام عليكم

اخي فضل

اذا اردت ان يتم اعتماد رقم القسم من مدى (افترض هنا انه المدى من C1:C36 )

سيكون الكود كالتالي


Sub Abu_Ahmed()

Application.ScreenUpdating = False

r = 4: rr = 5

For i = 1 To 36

[H2] = Cells(i + 1, 3)

[a1:b2852].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[H1:H2], CopyToRange:=Range(Cells(6, r), Cells(6, rr)), Unique:=True

r = r + 2

rr = rr + 2

Next

Application.ScreenUpdating = True

End Sub

رابط هذا التعليق
شارك

تسلم ياحبيبى

ولكن المدى هنا يكون من c2:c36 لانك جعلت الخلية اسم الخلية كالاتى Cells(i + 1, 3) أى الصف الثانى والعمود الثالث .

اما اذا كنت يتم تنفيذ الكود على اسم هذه الخلية Cells(i + 1, 3) ; كما فى الكود فاننا نجعل التكرار For i = 0 To 36 .

هذا مافعلته وقمت بتنفيذه والنتيجة صحيحة .وهل انا كذه صح .

الف شكر ياحبيبى بل يااستاذى تعلمنا منك الكثير ومازلنا نتعلم ربنا يخليك لنا وجزاك الله كل خير ودائما يامايسترو على رأى اخونا الفاضل ياسر الحافظ دينمو المنتدى .

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

تشكر يامايسترو وفى حفظ وامان الله .

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information