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

رفيع سعد · فبراير 3, 2015

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

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

Book1.rar

**الجموعي** · فبراير 3, 2015

تحويل المعادلات الى كود

تفضل الكود

Sub Formula()

    Range("K3").Formula = "=IF(M3<=1,"""",IF(M3>=1,B3))"
    Range("K4").Formula = "=IF(M4<=1,"""",IF(M4>=1,C3))"
    Range("K5").Formula = "=IF(M5<=1,"""",IF(M5>=1,D3))"
    Range("K6").Formula = "=IF(M6<=1,"""",IF(M6>=1,E3))"
    Range("K7").Formula = "=IF(M7<=1,"""",IF(M7>=1,B9))"
    Range("K8").Formula = "=IF(M8<=1,"""",IF(M8>=1,C9))"
    Range("K9").Formula = "=IF(M9<=1,"""",IF(M9>=1,D9))"
    Range("K10").Formula = "=IF(M10<=1,"""",IF(M10>=1,E9))"
    Range("K11").Formula = "=IF(M11<=1,"""",IF(M11>=1,B15))"
    Range("K12").Formula = "=IF(M12<=1,"""",IF(M12>=1,C15))"
    Range("K13").Formula = "=IF(M13<=1,"""",IF(M13>=1,D15))"
    Range("K14").Formula = "=IF(M14<=1,"""",IF(M14>=1,E15))"

End Sub

رفيع سعد · فبراير 3, 2015

السلام عليكم

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

**سليم حاصبيا** · فبراير 4, 2015

اكتب هذا الكود في حدث الصفحة

Sub FULFORMULA()
Range("K3").Formula = "=IF(M3<=1,"""",IF(M3>=1,B3))"

 Range("k3").Select
    Selection.AutoFill Destination:=Range("k3:k14"), Type:=xlFillDefault
End Sub

**سليم حاصبيا** · فبراير 4, 2015

تم تغيير الملف لاصابته بفيروس

مجرد ما تنقر الخلية C16 وتحرج منها تنتقل قيمتها الى الى العامود D

**ibn_egypt** · فبراير 4, 2015

اخى الفاضل

وبعد إذن أساتذتي الكرام أ.سليم وأ.الجموعي، جرب الملف المرفق لربما به طلبك

تحياتي :fff:

Transfer-Products.rar

رفيع سعد · فبراير 4, 2015

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

الاساتذة الافاضل السلام عليكم ورحمة الله وبركاتة شكرا لكم على الرد وبالنسبة لملف الاستاذ الفاضل ابن مصر فعلا هو دة المطلوب واطلب من حضرتك بعد اذنك شرح بسيط للكود لانى حابب افهم وكمان بعد اذنك بعد الترحيل عايز البيانات تتمسح من خلايا الكمية ويتم ترحيل بيانات الاعمدة من o4:z4 الى شيت 3 ولك منى جزيل الشكر

**ibn_egypt** · فبراير 4, 2015

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

الاساتذة الافاضل السلام عليكم ورحمة الله وبركاتة شكرا لكم على الرد وبالنسبة لملف الاستاذ الفاضل ابن مصر فعلا هو دة المطلوب واطلب من حضرتك بعد اذنك شرح بسيط للكود لانى حابب افهم وكمان بعد اذنك بعد الترحيل عايز البيانات تتمسح من خلايا الكمية ويتم ترحيل بيانات الاعمدة من o4:z4 الى شيت 3 ولك منى جزيل الشكر

اخى الفاضل

حضرتك متأكد من ترحيل النطاق ده .. النطاق ده مش مكتوب فيه الا "الاسم - العدد - صنف1-صنف2" والا انت تقصد الاصناف اللى طلعت وكمياتها واسعارها ... اذا كان كده ما نرحلها مباشرة لشيت 3 وخلاص

تحياتي :fff:

رفيع سعد · فبراير 4, 2015

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

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

**ibn_egypt** · فبراير 4, 2015

اخى الفاضل

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

تحياتي :fff:

Transfer-Products.rar

رفيع سعد · فبراير 4, 2015

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

أستاذى الفاضل ابن مصر أنا اسف أذا كنت بتقل عليك هو فعلا دو المطلوب بالتمام لكن انا كنت عايز الاصناف فى شيت all تكون فى الصف 2 صنف 1 صنف2 صنف3 وهكذا لان هيكون هناك ترحيل لعدد كبير من العملاء فيكون عدد الصفوف 3 صفوف لكل عميل كما فى الملف اللى فى اول الموضوع والطلب الاهم من دة كلة فضلا وتكرما منك شرح بسيط للكود او للاجزاء الهامة منة ويكون لك الف الف شكر

**ibn_egypt** · فبراير 4, 2015

اخى الفاضل

جرب الملف المرفق، تم التعديل بناءا على طلبك

تحياتي :fff:

Transfer-Products.rar

رفيع سعد · فبراير 4, 2015

أستاذى الفاضل ابن مصر

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

تم تعديل فبراير 4, 2015 بواسطه رفيع سعد

رفيع سعد · فبراير 5, 2015

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

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

ياسر خليل أبو البراء · فبراير 5, 2015

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

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

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

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

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

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

رفيع سعد · فبراير 5, 2015

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

استاذى العزيز ياسر والنبى انا راضى ذمتك (الحلقات التكرارية المتشابكة أو المتداخلة دي لا يتقنها إلا محترف مثل ابن مصر ) لما استاذ كبير زى حضرتك يقول كدة انا بقى المبتدئ اقول اية اصوت يعنى ولا اصوت (إليك شرح الكود الأول - وكفاية عليا كدا ) دة يرضيك يعنى انا طمعان فى كرمكم وهنيالك يافاعل الخير والثواب هههههههههه

ياسر خليل أبو البراء · فبراير 5, 2015

الأخ المشاكس رفيع سعد

من كان حليفا فليحلف بالله أو ليصمت (متقولش والنبي تاني وإلا مش هعبرك تاني ههههه) .. :yes:

أتعبتني ..وولكن ولا يهمك المهم تدعي للكبير ابن مصر ولا تنساني أنا الآخر بدعوة بظهر الغيب

Sub TransferProducts()
    'تعريف المتغيرات
    Dim ws, ws2 As Worksheet
    Dim lr, lr2 As Long
    '[Data]لورقة العمل التي باسم[ws]تعيين المتغير
    Set ws = ThisWorkbook.Sheets("Data")
    '[All]لورقة العمل التي باسم[ws2]تعيين المتغير
    Set ws2 = ThisWorkbook.Sheets("All")
    '[ws]في ورقة العمل[K]تعيين رقم آخر صف به بيانات في العمود
    lr = ws.Cells(Rows.Count, 11).End(xlUp).Row
    '[ws2]تعيين رقم أول صف فارغ في العمود الرابع في ورقة العمل
    lr2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row + 1
    'إيقاف خاصية إهتزاز الشاشة
    Application.ScreenUpdating = False
        'إظهار رسالة تفيد بتأكيد الترحيل من عدمه ، فإذا تم الضغط على زر الأمر لا يتم الخروج من الإجراء الفرعي
        If MsgBox("  هل تريد بالتأكيد ترحيل البيانات ومسحها" & vbCr & vbCr & String$(40, "="), vbCritical + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading + vbDefaultButton2, "تاكيد الترحيل ") = vbNo Then Exit Sub
        '[H3:J3]يتم نسخ بيانات الزبون الموجودة في النطاق
        ws.Range("H3:J3").Copy
        '[ws2]بعد عملية النسخ يتم لصق البيانات في العمود الأول في ورقة العمل
        ws2.Range("A" & lr2).PasteSpecial (xlPasteValues)
        'يتم نسخ النتائج التي تم استخراجها من الكود السابق
        ws.Range("K3:M" & lr).Copy
        'يتم لصق البيانات ولكن بشكل أفقي وليس عمودي في بداية العمود الرابع
        ws2.Range("D" & lr2).PasteSpecial (xlPasteValues), , , True
        'إلغاء خاصية النسخ واللصق
        Application.CutCopyMode = False
        '[ws]مسح النطاق الذي يحتوي على النتائج حتى آخر خلية بها بيانات في ورقة العمل
        ws.Range("K3:M" & lr).ClearContents
        '[clear]استدعاء الإجراء الفرعي المسمى
        Call clear
    'إعادة تفعيل خاصية إهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

Sub clear()
    'تعريف المتغيرات
    Dim ws As Worksheet
    Dim lr, lr2, lr3 As Long
    Dim i, y As Integer
    '[Data]لورقة العمل التي باسم[ws]تعيين المتغير
    Set ws = ThisWorkbook.Sheets("Data")
    '[ws]تعيين رقم آخر صف به بيانات في العمود الأول في ورقة العمل
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    '[ws]بدء التعامل مع ورقة العمل
    With ws
        'حلقة تكرارية للأعمدة من العمود الثاني إلى العمود الخامس
        For y = 2 To 5
            'حلقة تكرارية من الصف الثالث وحتى آخر صف به بيانات
            For i = 3 To lr Step 6
                'يتم مسح الخلاياالتي بها الكميات
                .Cells(i + 1, y).Value = ""
            Next i
        Next y
    End With
End Sub

تم تعديل فبراير 5, 2015 بواسطه YasserKhalil

**ibn_egypt** · فبراير 5, 2015

يا طول بالك يا كبير

جزاك الله كل خير أستاذي الكريم

عارف انا انك لا تروق لك الحلقات التكرارية المتداخلة ... :rol: :rol:

:fff: تحياتى :fff:

ياسر خليل أبو البراء · فبراير 5, 2015

أخي وحبيبي ابن مصر

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

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

تقبل تحياتي

رفيع سعد · فبراير 5, 2015

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

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

ياسر خليل أبو البراء · فبراير 5, 2015

الأخ الحبيب رفيع سعد

لا داعي للأسف فلكنا نخطيء أخي الكريم

وأنا لا أنسى لك جميلاً قدمته لي ، حيث أنك أول من أوحيت لي بفكرة حلقات (افتح الباب) ..صحيح !! حدثت الفكرة بعدما طلبت مني شرح جزئية معينة فاكتشفت أنني أجيد الشرح نوعاً ما بطريقة مختلفة فقررت أن أطرح موضوع بسيط عن كيفية البدء مع البرمجة ، وتطورت الفكرة لحلقات افتح الباب ، والحمد لله أظنها تسير بشكل مقبول إلى حدٍ ما ..

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

رفيع سعد · فبراير 5, 2015

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

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

ياسر خليل أبو البراء · فبراير 5, 2015

أخي الحبيب رفيع سعد (طير إنت)

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

تقبل تحياتي

رفيع سعد · فبراير 7, 2015

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

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

1.rar

تم تعديل فبراير 7, 2015 بواسطه رفيع سعد

**ibn_egypt** · فبراير 8, 2015

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

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

اخى الفاضل

جرب الملف المرفق لربما به طلبك ..

تحياتي :fff:

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

تسجيل الدخول

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

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

رفيع سعد

الجموعي

رفيع سعد

سليم حاصبيا

سليم حاصبيا

ibn_egypt

رفيع سعد

ibn_egypt

رفيع سعد

ibn_egypt

رفيع سعد

ibn_egypt

رفيع سعد

رفيع سعد

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

رفيع سعد

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

ibn_egypt

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

رفيع سعد

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

رفيع سعد

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

رفيع سعد

ibn_egypt

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information