رجاء تحويل هذة المعادلات الى كود

[رفيع سعد]

بسم الله الرحمن الرحيم

أستاذى الغالى أبن مصر سلمت بمينك وزادك الله من علمة لك منى الف شكر هو دة بالظبط وأكثر ما كنت أريدة            

[رفيع سعد]

بسم الله الرحمن الرحيم

الاساتذة الكرام سلام اللة عليكم ورحمتة وبركاتة الحمد لله بفضلكم تم الاجابة على طلبى على اكمل وجة وأخص بالفضل الاستاذ أبن مصر والاستاذ ياسر خليل جزاهم الله كل خير بس عندى أستفسار بسيط لو عايز أكرر نفس ورقتين العمل فى شيت 3 و4 فى نفس الملف وغير مرتبطين بشيت 1و2 وكانهم عمل مستقل فهل ينفع أن أقوم بنسخ الكود ولصقة فى شيت 3 وتعديل اسم المتغير ws , ws2 الى  ws3,,ws4  أن تكرمتم بالرد فهذا فضل زائد منكم وأن لم يكن هناك رد    فما قصرتم ولكم مليون شكر

[ibn_egypt]

 

بسم الله الرحمن الرحيم

الاساتذة الكرام سلام اللة عليكم ورحمتة وبركاتة الحمد لله بفضلكم تم الاجابة على طلبى على اكمل وجة وأخص بالفضل الاستاذ أبن مصر والاستاذ ياسر خليل جزاهم الله كل خير بس عندى أستفسار بسيط لو عايز أكرر نفس ورقتين العمل فى شيت 3 و4 فى نفس الملف وغير مرتبطين بشيت 1و2 وكانهم عمل مستقل فهل ينفع أن أقوم بنسخ الكود ولصقة فى شيت 3 وتعديل اسم المتغير ws , ws2 الى  ws3,,ws4  أن تكرمتم بالرد فهذا فضل زائد منكم وأن لم يكن هناك رد    فما قصرتم ولكم مليون شكر

 

 

اخى الفاضل

 

طبعا ينفع تنسخ الكود وتلصقه بس تغير اسم الموديول اولا بدلا من FilterProduct سميه مثلا FilterProduct2 

 

ثانيا مش مهم تغير ws,ws2 ... المهم تغير اسم الورقة يعني من Data الى Data2 او الورقة All تخليها بالاسم الجديد وليكن All2 وهكذا

 

شاهد المرفق

 

تحياتي  

بعد التعديل.rar

[رفيع سعد]

بسم الله الرحمن الرحيم

أستاذى الغالى أبن مصر ربنا  ميحرمناش منك أثابك الله عنا كل الخير

[رفيع سعد]

بسم الله الرحمن الرحيم

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

بعد التعديل.rar

[رفيع سعد]

بسم الله الرحمن الرحيم

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

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

لو تطرح طلبك الجديد في موضوع مستقل يكون أفضل حتى يستطيع الأخوة رؤية الموضوع لأن كثرة الردود في الموضوع الواحد بتخلي الأعضاء يتوهوا ..

أنا نفسي نسيت الموضوع رغم إني شاركت فيه!!!!!!!

[رفيع سعد]

بسم الله الرحمن الرحيم

استاذى العزيز ياسر رافع روحى المعنوية انا كنت خلاص قولت ان الموضوع خلص لكن ظهرت هذة الملحوظة فقلت اخلص الموضوع بأخر سؤال واتمم الماف 

[سـامي 169]

الاخ الحبيب رفيع

إليك شرح الكود الأول - وكفاية عليا كدا - ..

Sub FilterProduct()
'تعريف المتغيرات
Dim ws As Worksheet
Dim lr, lr2, lr3 As Long
Dim i, y As Integer

'[Data]لورقة العمل التي باسم[ws]تعيين المتغير
Set ws = ThisWorkbook.Sheets("Data")
'تعيين رقم آخر صف به بيانات في العمود الأول
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    'إيقاف خاصية إهتزاز الشاشة
    Application.ScreenUpdating = False
        'بدء التعامل مع ورقة العمل
        With ws
            'مسح النطاق الذي تظهر فيه النتائج
            .Range("K3:M1000").ClearContents
            'حلقة تكرارية للعمود الثاني والثالث والرابع والخامس
            For y = 2 To 5
                '[K]متغير لتحديد أول خلية فارغة لطبع النتائج بها في العمود
                lr2 = .Cells(Rows.Count, 11).End(xlUp).Row + 1
                'حلقة تكرارية في الصفوف ابتداءً من الصف الثالث وحتى آخر صف به بيانات ، مع التخطي 6 خطوات
                For i = 3 To lr Step 6
                    'إذا كانت الخلية التي يظهر بها الثمن ليست فارغة وأكبر من واحد
                    If .Cells(i + 2, y).Value <> "" And .Cells(i + 2, y) > 1 Then
                         'تساوي أسماء الأصناف في صفوف الأصناف[K]الخلايا في العمود
                        .Cells(lr2, 11).Value = .Cells(i, y).Value
                         'تساوي الكميات في صفوف الكمية[L]الخلايا في العمود
                        .Cells(lr2, 12).Value = .Cells(i + 1, y).Value
                         'تساوي الأسعار في صفوف الثمن[M]الخلايا في العمود
                        .Cells(lr2, 13).Value = .Cells(i + 2, y).Value
                        'زيادة المتغير بقيمة واحد للانتقال إلى خلية فارغة جاهزة لطبع النتائج بها
                        lr2 = lr2 + 1
                       'إذا لم يتحقق الشرط
                       Else
                        'يبقى المتغير بنفس القيمة بدون زيادة
                        lr2 = lr2
                     End If
                Next i
            Next y
        End With
    'إعادة تفعيل خاصية إهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

أرجو أن يكون الشرح واضح وصريح ومش محتاج توضيح

الحلقات التكرارية المتشابكة أو المتداخلة دي لا يتقنها إلا محترف مثل ابن مصر

سلمت يمناك يا ابن مصر

اول مرة افهم اكواد شرح سهل ربنا يحفظكم استا ياسر

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

[رفيع سعد]

لو تطرح طلبك الجديد في موضوع مستقل يكون أفضل حتى يستطيع الأخوة رؤية الموضوع لأن كثرة الردود في الموضوع الواحد بتخلي الأعضاء يتوهوا ..

أنا نفسي نسيت الموضوع رغم إني شاركت فيه!!!!!!!

بسم الله الرحمن الرحيم

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