اذهب الي المحتوي
أوفيسنا

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

قام بنشر

عندي ملف.. عبارة عن بيان تعبئة .. يشمل غالبا على ما يزيد عن 300 صنف .. و أغلب الأوقات يتكرر الصنف في أكثر من موضع

نظرا لموضعه داخل الكراتين.. و عند تفريغ بيان التعبئة إلى فاتورة للبيع للعميل..يحدث في أغلب الأحيان خطأ في كتابة سعر الصنف

في بعض المواضع التي يتكرر فيها الصنف.. فيحتاج الشخص للمراجعة عند حدوث غلط في قيمة الفاتورة تباع للغلط في بيان التعبئة إلى وقت طويل

للمراجعى و اكتشاف الخطأ و موضعه بالنسبة للسعر أو للكمية كذلك .. ..

أتمنى ان تشاهدوا المرفق و تساعدوني .. و بارك الله فيكم جميعا و عيدكم مبارك

إشكال في بيان التعبئة.rar

قام بنشر

السلام عليكم

أخي العزيز

جرب المرفق

أو ضع الكود التالي في حدث الورقة

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

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

إذا وقفت داخل الجدول سيتم تلوين الصفوف بالجدول التي تحتوي علي نفس الصنف بالسطر الحالي باللون الأخضر

وإذا كان UNIT PRICE لها غير متساوي مثل M1 أو M2

فسيكون لونه أحمر وإلا سيكون مثل الباقي أخضر

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

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

اضافة الى حل اخي المهندس طارق

ولإثراء الموضوع

في المرفق يتم الانتقال الى السعر المختلف لنفس الصنف من خلال النقر بالماوس

يعيب الملف طول المعادلة المستخدمة.

تحياتي

إشكال في بيان التعبئة1.rar

قام بنشر

يا أهلا بأهل الغوث و البركة... أسأل الله -إن كان لي من دعوة مستجابة- أن يجعل أيامكم كلها أعياد و أن يجعلكم بين الخلائق أعياناًو أسياد..

استاذي طارق : اشكرك شكر المتاج للعون فأعنته.. وشكر المستغيث فنجَّيته.. كفيت ووفيت ...

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

وفضله و إياي..

أتسائل : بالنسبة لأكواد الأستاذ طارق.. هل بالإمكان أن يتم جمع الكمية كاملة للصنف المكرر الملون باللون الأحمر أمام أول موضع تكرير له؟

الف الف شكر لكم جميعا..و كل عام و أنتم بالف خير

قام بنشر

الله يجعلها لعلمك زكاة مقبولة يا استاذ طارق ..جزاك الله خيرا ... اختصرت علي كثيرا من الجهد و الوقت بهذا الحل

قام بنشر

استاذ طارق... قد كثرت عليك.. و أطمع في كرمك..

هل يمكن أن يعمل الكود فقط في الأصناف المكررة ؟؟ و يسكت عن الذي ليس مكررا ؟؟

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

السلام عليكم ولايهمك ياأستاذ المهم المعلومة توصل لمن يحتاجها

تقول

هل يمكن أن يعمل الكود فقط في الأصناف المكررة ؟؟ و يسكت عن الذي ليس مكررا ؟؟

نعم طبعا

أضف للكود بعد سطر

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

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

زائر
اضف رد علي هذا الموضوع....

×   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.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information