اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر (معدل)

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

وبه نستعين

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

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

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

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

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

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

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

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

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

تم تعديل بواسطه سعيد بيرم
قام بنشر

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

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

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

عموماً جرب التعديل التالي للجزء الأول من طلبك وهو ترحيل الثلاثة أعمدة من 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

تقبل تحياتي

  • Like 1
قام بنشر (معدل)

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

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

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

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

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

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

تم تعديل بواسطه سعيد بيرم
قام بنشر

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

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

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

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

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

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

قام بنشر (معدل)

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

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

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

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

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

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

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

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

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

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

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

تم تعديل بواسطه سعيد بيرم
قام بنشر

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

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

تم تعديل بواسطه سعيد بيرم
قام بنشر

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

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

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:

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

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

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

السلام عليكم

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

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

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

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

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

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

تم تعديل بواسطه سعيد بيرم
  • Like 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.

×
×
  • اضف...

Important Information