طلب تعديل وإضافة فى كودى الخصم والاضافة للأصناف

[أبو عبد الرحمن سعيد]

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

وبه نستعين

إخوانى الافاضل

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

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

المرفق التالى عبارة عن إضافة وخصم كميات مع كل ادخال جديد

المطلوب بحول الله تعالى

التعديل على كلا الكودين والاضافات المطلوبه بالمرفق التالى

برجاء الاطلاع والافادة بإذن الله تعالى

تقبلوا وافر تقديرى واحترامى **** وجزاكم الله خيرا

طلب تعديل وإضافة فى كودى الخصم والاضافة.xlsb.rar

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

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

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

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

التعديل يستلزم مراجعة الكود من البداية للنهاية للوصول لحل

عموماً جرب التعديل التالي للجزء الأول من طلبك وهو ترحيل الثلاثة أعمدة من C إلى E ..إلى قائمة المخازن (مع الإضافة في كل مرة يتم فيها تنفيذ الكود)

Sub TransferMatchingData()
    Dim vItems As Variant, vData As Variant, vOut As Variant, I As Long
    
    vItems = Sheet1.Range("B8", Sheet1.Cells(Rows.Count, "B").End(xlUp)).Resize(, 4).Value
    
    With Sheet2.Range("B8", Sheet2.Cells(Rows.Count, "B").End(xlUp))
        vData = .Value
        vOut = .Offset(, 1).Resize(, 3).Value
        
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For I = LBound(vItems) To UBound(vItems)
                .Item(vItems(I, 1)) = vItems(I, 2) & "|" & vItems(I, 3)
            Next I
            
            For I = LBound(vData) To UBound(vData)
                If .Exists(vData(I, 1)) Then
                    vOut(I, 1) = Split(.Item(vData(I, 1)), "|")(0)
                    vOut(I, 2) = Split(.Item(vData(I, 1)), "|")(1)
                    vOut(I, 3) = vOut(I, 3) + vOut(I, 1)
                Else
                    vOut(I, 1) = ""
                End If
            Next I
        End With
        
        .Offset(, 1).Resize(, 3).Value = vOut
    End With
End Sub

تقبل تحياتي

[أبو عبد الرحمن سعيد]

اخى الحبيب ابو البراء

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

بداية جزاكم الله خيرا وبارك فيكم وحمدا لله على سلامتكم

بشأن العمود المعنى بالاضافة كلما تم تنفيذالكود هو العمود E " عمود الكميات الواردة "

فيما عدا ذلك فالامور تسرى على مايرام **** نأمل فى تحقيق الجزء الثانى من الطلب الاول

تقبل وافر احترامى وتقديرى وجزاكم الله خيرا

تم تعديل فبراير 13, 2016 بواسطه سعيد بيرم

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

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

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

حيث أنك تعرف جيداً وتعرف تمام العلم أن الموضوع ذو الطلبات المتعددة ينفر الأعضاء من الموضوع

............

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

أرجو أن تتحملني فيما يخص بالتوجيهات (فهذا والله من مصلحتك في المقام الأول .. )

[أبو عبد الرحمن سعيد]

اخى الحبيب ابو البراء

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

بداية جزاكم الله خيرا وبارك فيكم

لديك الحق فيما يتعلق بالتركيز ولكن عزائى ان عدد تعديل المشاركات

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

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

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

اليك أخى الحبيب المرفق كما طلبت موضحا فيه المطلوب

مشفوعا بالكود المشاراليه بمشاركتكم القيمة بالمشاركة رقم 2

تقبل وافر تقديرى وجزاكم الله خيرا

طلب تعديل وإضافة فى كود الاضافة +1111111.rar

تم تعديل فبراير 13, 2016 بواسطه سعيد بيرم

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

جرب التعديل التالي

Sub TransferMatchingData()
    Dim vItems As Variant, vData As Variant, vOut As Variant, I As Long
    
    vItems = Sheet1.Range("B8", Sheet1.Cells(Rows.Count, "B").End(xlUp)).Resize(, 4).Value
    
    With Sheet2.Range("B8", Sheet2.Cells(Rows.Count, "B").End(xlUp))
        vData = .Value
        vOut = .Offset(, 1).Resize(, 3).Value
        
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For I = LBound(vItems) To UBound(vItems)
                .Item(vItems(I, 1)) = vItems(I, 4) & "|" & vItems(I, 3)
            Next I
            
            For I = LBound(vData) To UBound(vData)
                If .Exists(vData(I, 1)) Then
                    vOut(I, 1) = Split(.Item(vData(I, 1)), "|")(0)
                    vOut(I, 2) = Split(.Item(vData(I, 1)), "|")(1)
                    vOut(I, 3) = vOut(I, 3) + vOut(I, 1)
                Else
                    vOut(I, 1) = ""
                End If
            Next I
        End With
        
        .Offset(, 1).Resize(, 3).Value = vOut
    End With
End Sub

بالنسبة للإضافة المطلوبة أعتقد أنه تم العمل عليها من قبل في كود منفصل

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

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

تقبل تحياتي

 

[أبو عبد الرحمن سعيد]

حبيبى ابو البراء

السلام عليكم

بشأن كودى الحذف والاضافة فهما يمثلان أهم اكواد

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

ادرك أن الاضافة المطلوبه قد تمت بكود منفصل

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

نظرا لاحراجى أمام كرم اخلاقكم الكريمة

رغم انى عارف أنك أدها ***** وربنا يحميك ويبارك لك فى ولدك

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

برجاء الاطلاع على المرفق التالى

تقبل وافر تقديرى واحترامى وجزاكم الله خيرا

طلب تعديل وإضافة فى كود الاضافة +22222222.rar

تم تعديل فبراير 13, 2016 بواسطه سعيد بيرم

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

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

إليك آخر تعديل سأقوم به (عندي مشاغل خاصة وسأغيب عن المنتدى لهذه الليلة ) إذا لم يكن المطلوب أرجو تدخل أحد الأخوة لتقديم المساعدة

Sub TransferMatchingData()
    Dim vItems As Variant, vData As Variant, vOut As Variant, I As Long
    
    vItems = Sheet1.Range("B8", Sheet1.Cells(Rows.Count, "B").End(xlUp)).Resize(, 4).Value
    
    With Sheet2.Range("B8", Sheet2.Cells(Rows.Count, "B").End(xlUp))
        vData = .Value
        vOut = .Offset(, 1).Resize(, 3).Value
        
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For I = LBound(vItems) To UBound(vItems)
                .Item(vItems(I, 1)) = vItems(I, 4) & "|" & vItems(I, 3) & "|" & vItems(I, 2)
            Next I
            
            For I = LBound(vData) To UBound(vData)
                If .Exists(vData(I, 1)) Then
                    vOut(I, 1) = Split(.Item(vData(I, 1)), "|")(2)
                    vOut(I, 2) = Split(.Item(vData(I, 1)), "|")(1)
                    vOut(I, 3) = vOut(I, 3) + Split(.Item(vData(I, 1)), "|")(0)
                Else
                    vOut(I, 1) = ""
                End If
            Next I
        End With
        
        .Offset(, 1).Resize(, 3).Value = vOut
    End With
End Sub

تقبل تحياتي

 

[أبو عبد الرحمن سعيد]

في 2/13/2016 at 20:28, ياسر خليل أبو البراء said:

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

إليك آخر تعديل سأقوم به (عندي مشاغل خاصة وسأغيب عن المنتدى لهذه الليلة ) إذا لم يكن المطلوب أرجو تدخل أحد الأخوة لتقديم المساعدة

اخى الحبيب المحترم // ابو البراء

السلام عليكم

الحمد لله تعالى ان تعبك جاء بفائدة كبيرة جعله الله فى ميزان حسناتك

واعانك الله على مشاغلك بس الله يكرمك ياريت مش أكتر من ليله غياب

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

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

الكود لاننى على يقين بالله ثم بكم اخى الحبيب أنه لامستحيل تحقيقه

تقبل وافر تقديرى واحترامى وجزاكم الله خيرا

تم تعديل فبراير 13, 2016 بواسطه سعيد بيرم