onlymanly قام بنشر سبتمبر 14, 2010 قام بنشر سبتمبر 14, 2010 عندي ملف.. عبارة عن بيان تعبئة .. يشمل غالبا على ما يزيد عن 300 صنف .. و أغلب الأوقات يتكرر الصنف في أكثر من موضع نظرا لموضعه داخل الكراتين.. و عند تفريغ بيان التعبئة إلى فاتورة للبيع للعميل..يحدث في أغلب الأحيان خطأ في كتابة سعر الصنف في بعض المواضع التي يتكرر فيها الصنف.. فيحتاج الشخص للمراجعة عند حدوث غلط في قيمة الفاتورة تباع للغلط في بيان التعبئة إلى وقت طويل للمراجعى و اكتشاف الخطأ و موضعه بالنسبة للسعر أو للكمية كذلك .. .. أتمنى ان تشاهدوا المرفق و تساعدوني .. و بارك الله فيكم جميعا و عيدكم مبارك إشكال في بيان التعبئة.rar
طارق محمود قام بنشر سبتمبر 15, 2010 قام بنشر سبتمبر 15, 2010 السلام عليكم أخي العزيز جرب المرفق أو ضع الكود التالي في حدث الورقة Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myrange, a, b As Range, rep(99) As Integer On Error GoTo ErrHandler Application.EnableEvents = False rr = Target.Row x = [a1].Offset(rr - 1, 0) Set myrange = Range("A14:A64") Range("A14:L64").Interior.Pattern = xlNone i = 0 For Each s In myrange y = s.Value If y = x Then i = i + 1 Range("A" & s.Row, "L" & s.Row).Interior.ColorIndex = 4 rep(i) = s.Row End If Next s For j = 1 To i Set a = Range("H" & rep(j)) For nj = 1 To i Set b = Range("H" & rep(nj)) If b.Value <> a.Value Then b.Interior.ColorIndex = 3 Next nj Next j ErrHandler: Application.EnableEvents = True End Sub onlyman-2.rar
طارق محمود قام بنشر سبتمبر 15, 2010 قام بنشر سبتمبر 15, 2010 (معدل) إذا وقفت داخل الجدول سيتم تلوين الصفوف بالجدول التي تحتوي علي نفس الصنف بالسطر الحالي باللون الأخضر وإذا كان UNIT PRICE لها غير متساوي مثل M1 أو M2 فسيكون لونه أحمر وإلا سيكون مثل الباقي أخضر تم تعديل سبتمبر 15, 2010 بواسطه TareQ M
الخالدي قام بنشر سبتمبر 15, 2010 قام بنشر سبتمبر 15, 2010 السلام عليكم ورحمة الله وبركاته اضافة الى حل اخي المهندس طارق ولإثراء الموضوع في المرفق يتم الانتقال الى السعر المختلف لنفس الصنف من خلال النقر بالماوس يعيب الملف طول المعادلة المستخدمة. تحياتي إشكال في بيان التعبئة1.rar
onlymanly قام بنشر سبتمبر 16, 2010 الكاتب قام بنشر سبتمبر 16, 2010 يا أهلا بأهل الغوث و البركة... أسأل الله -إن كان لي من دعوة مستجابة- أن يجعل أيامكم كلها أعياد و أن يجعلكم بين الخلائق أعياناًو أسياد.. استاذي طارق : اشكرك شكر المتاج للعون فأعنته.. وشكر المستغيث فنجَّيته.. كفيت ووفيت ... أستاذي الخالد: لك الشكر و الإمتنان حتى ترضى .. عودتنا على إيجاد الحلول بالمعادلات و إن كانت مستعصية ... بارك الله فيك و في علمك و زادك من واسع جوده وفضله و إياي.. أتسائل : بالنسبة لأكواد الأستاذ طارق.. هل بالإمكان أن يتم جمع الكمية كاملة للصنف المكرر الملون باللون الأحمر أمام أول موضع تكرير له؟ الف الف شكر لكم جميعا..و كل عام و أنتم بالف خير
طارق محمود قام بنشر سبتمبر 16, 2010 قام بنشر سبتمبر 16, 2010 السلام عليكم أتسائل : بالنسبة للأكواد .. هل بالإمكان أن يتم جمع الكمية كاملة للصنف المكرر الملون باللون الأحمر أمام أول موضع تكرير له؟ نعم أخي يمكن ذلك تفضل المرفق onlyman-3.rar
onlymanly قام بنشر سبتمبر 16, 2010 الكاتب قام بنشر سبتمبر 16, 2010 الله يجعلها لعلمك زكاة مقبولة يا استاذ طارق ..جزاك الله خيرا ... اختصرت علي كثيرا من الجهد و الوقت بهذا الحل
onlymanly قام بنشر سبتمبر 16, 2010 الكاتب قام بنشر سبتمبر 16, 2010 استاذ طارق... قد كثرت عليك.. و أطمع في كرمك.. هل يمكن أن يعمل الكود فقط في الأصناف المكررة ؟؟ و يسكت عن الذي ليس مكررا ؟؟
طارق محمود قام بنشر سبتمبر 16, 2010 قام بنشر سبتمبر 16, 2010 (معدل) السلام عليكم ولايهمك ياأستاذ المهم المعلومة توصل لمن يحتاجها تقول هل يمكن أن يعمل الكود فقط في الأصناف المكررة ؟؟ و يسكت عن الذي ليس مكررا ؟؟ نعم طبعا أضف للكود بعد سطر On Error GoTo ErrHandler السطور التالية If Range("J" & Target.Row).Value = 1 Then Range("A14:L64").Interior.Pattern = xlNone Exit Sub End If أو إستبدل الكود كله بالتالي Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myrange, a, b As Range, rep(99) As Integer On Error GoTo ErrHandler If Range("J" & Target.Row).Value = 1 Then Range("A14:L64").Interior.Pattern = xlNone Exit Sub End If Application.EnableEvents = False rr = Target.Row x = [a1].Offset(rr - 1, 0) Set myrange = Range("A14:A64") Range("A14:L64").Interior.Pattern = xlNone i = 0 Range("M14:M64").ClearContents For Each s In myrange y = s.Value If y = x Then i = i + 1 Range("A" & s.Row, "L" & s.Row).Interior.ColorIndex = 4 rep(i) = s.Row End If Next s sum_nj = 0: chg = 0 For j = 1 To i Set a = Range("H" & rep(j)) For nj = 1 To i Set b = Range("H" & rep(nj)) If b.Value <> a.Value Then chg = 1: b.Interior.ColorIndex = 3 Next nj Next j If chg <> 0 Then For j = 1 To i sum_nj = sum_nj + Range("G" & rep(j)).Value Next j End If If sum_nj <> 0 Then Range("M" & rep(1)).Value = sum_nj ErrHandler: Application.EnableEvents = True End Sub تم تعديل سبتمبر 16, 2010 بواسطه TareQ M
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.