(تمت الإجابة) كيف أجعل البرنامج يختار أحسن نتيجة من الجدول

أبو أريج · ديسمبر 5, 2011

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

عيد سعيد للجميع

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

بارك الله فيكم مسبقا

compression.rar

أبو أريج · ديسمبر 6, 2011

صباح الخير

عفوا على الالحاح

**طارق محمود** · ديسمبر 6, 2011

السلام عليكم

أخي الكريم

تفضل المرفق به الحل

باستخدام التنسيق الشرطي

الشرط الأول يلون بالأحمر كل مافي الجدول ويزيد عن أو يساوي المساحة المطلوبة Asc

الشرط الثاني يلون بالأخضر كل مافي الجدول ويحقق الشرط الأول وفي نفس الوقت لايزيد عن مرة ونصف المساحة المطلوبة Asc

المرفق علي الرابط

http://www.4shared.com/file/Lj37HIJz/compression_TAREQ.html

أبو أريج · ديسمبر 6, 2011

السلام عليكم

فكرة جيدة بارك الله فيك

**طارق محمود** · ديسمبر 6, 2011

أخي الفاضل

لقد أرفقت هنا ملفا آخر به حل أفضل :rol:

أيضا باستخدام التنسيق الشرطي مع جدول مساعد تحصل علي القيمة الأفضل في حالتنا هي 8.04

ستجد في المرفق بجوار جدولك الأصلي جدول آخر بلون ضعيف ، وهو جدول مساعد وظيفته أنه يظهر الترتيب للمساحات المختلفة

فالقيمة صفر تعني أن هذه الخلية خارج المنافسةوالقيمة 1 تعني أبعد رقم عن المطلوب(أي أكبر مساحة)

القيمة المطلوبة هي المقابلة لأكبر رقم في الجدول المساعد

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

حيث مساحة الواحد =

(PI).D[sup]2[/sup]/400

PI هي النسبة التقريبية

تستطيع تغيير الأرقام لتتغير قيمة المساحة المطلوبة Asc

لتشاهد الفرق أوتوماتيكيا

المرفق علي الرابط

http://www.4shared.c...ion_TAREQ2.html

**abouelhassan** · ديسمبر 6, 2011

شكر وتقدير وفائق الاحترام اسستاذنا

لمجهوداتك ورووائعك

بارك الله فيك

اخيك باحترام

أبو أريج · ديسمبر 6, 2011

السلام عليكم أخي الكريم طارق

إنه حقيقة حل أفضل من الأول

ـقبل مني كامل تقديري و احترامي

أبو أريج · ديسمبر 6, 2011

السلام عليكم

عفوا نسيت أن أسألك كيف تحصلت على اللون الباهت للجدول و الأرقام و كيفية استبدال العلامة 0 بالعلامة(-) و هل يمكن استعمال التنسيق الشرطي لتلوين خانة أكبر عدد (max) ؟

**طارق محمود** · ديسمبر 6, 2011

اللون الباهت للجدول و الأرقام من ايكونة الألوان إختر مايعجبك

إستبدال العلامة 0 بالعلامة(-) من تنسيق الأرقام

طبعا ممكن استعمال التنسيق الشرطي لتلوين خانة أكبر عدد (max) وهذا ماتم في الملف الثاني راجعه مرة أخري

أبو أريج · ديسمبر 6, 2011

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

**طارق محمود** · ديسمبر 6, 2011

لاعليك أخي الفاضل

راجع الملف واسأل كما يحلو لك

وأزيدك أنه ممكن أيضا التنويع كما هو الحال في الواقع

بمعني مثلا إذا كانت مساحة الحديد المطلوب = 10.60 سم2

فمن الممكن أن يختار البرنامج 4 قطر 12 + 4 قطر 14 ليكون 10.67 بدلا من إختيار 10 قطر 12 وهي الأقرب في الجدول 11.31سم2

ولكن هذا قد يحتاج كود صغير

أبو أريج · ديسمبر 6, 2011

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

ألفففففففففففففف شكر

**طارق محمود** · ديسمبر 7, 2011

السلام عليكم

أخي الكريم

أنظر الملف المرفق - الورقة tableau2

ستجد مايسرك

compression_TAREQ3.rar

**طارق محمود** · ديسمبر 7, 2011

في المرفق ايضا إضافة صغيرة جميلة

compression_TAREQ4.rar

أبو أريج · ديسمبر 8, 2011

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

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

مع كامل إحتراماتي و تقديري

طلب أخير إن سمحت:

هل يمكن أن تجعل عدد القضبان المختارة عدد زوجي لأنه تسليح عمود خرساني :signthankspin:

**طارق محمود** · ديسمبر 8, 2011

السلام عليكم

ممكن تجعل الخطوة ثنائية في حلقة عداد الكميات

بإضافة جملة Step 2

لآخر كل سطر يبدأ بـ For q أو For qq

وسيكون الكود النهائي هكذا


Private Sub Worksheet_Calculate()

Application.ScreenUpdating = False

Dim dia(99), d As Integer, A(99, 99) As Double

i = 0

For d = 10 To 40 Step 2

    If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10

    If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10

    i = i + 1

    dia(i) = d

10 Next d

For q = 2 To 12

    For i = 1 To 12

		    A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2)

		    'Cells((q - 1) * 12 + i, "V") = "A(" & q & "dia-" & dia(i) & ")"

		    'Cells((q - 1) * 12 + i, "W") = A(q, i)

    Next i


Next q

A_min = 2 * [S4] / 100

For q = 2 To 12 Step 2

    For i = 1 To 12

	    For qq = 2 To 12 Step 2

		    For ii = 1 To 12

			    If ii = i Then GoTo 20

			    If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20

			    If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20

			    If (A(q, i) + A(qq, ii)) < A_min Then

				    A_min = A(q, i) + A(qq, ii)

				    Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min

				    q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii)

			    End If

20		  Next ii


	    Next qq

    Next i


Next q


For q = 2 To 12 Step 2

    For i = 1 To 12

	    If A(q, i) < [S4] / 100 Then GoTo 30

	    If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30

	    If A(q, i) < A_min Then

		    A_min = A(q, i) + A(qq, ii)

		    Chosn = q & "f" & dia(i) & " = " & A_min

		    q1 = q: d1 = dia(i): q2 = 0: d2 = 0

	    End If

30  Next i

Next q

[S6] = Chosn

[E5:P16].Interior.ColorIndex = xlNone

cc1 = WorksheetFunction.Match(q1, [E4:P4], 0)

rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0)

Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3

If q2 = 0 Then GoTo 55

    cc2 = WorksheetFunction.Match(q2, [E4:P4], 0)

    rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0)

    Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3

55

Application.ScreenUpdating = True

End Sub

أبو أريج · ديسمبر 8, 2011

السلام عليكم

ألف ألف شكر هذا يفي بالغرض و زيادة

**طارق محمود** · ديسمبر 8, 2011

السلام عليكم

مازال الملف ليس بالكمال المطلوب

أعلم أن الأفضل أن تكون الأقطار متقاربة

فلايجوز مثلا ان تستخدم قطر 12 ، 20

الأفضل أن يكون فارق درجة واحدة أو إثنين علي الأكثر

ولكن إلي السبت القادم إن شاء الله

أبو أريج · ديسمبر 8, 2011

السبت ان شاء الله

**طارق محمود** · ديسمبر 10, 2011

السلام عليكم

أخي العزيز

فقط اضف السطر التالي في حلقة الإختيار

If Abs(i - ii) > 2 Then GoTo 20

ليكون الكود في النهاية هكذا


Private Sub Worksheet_Calculate()

Application.ScreenUpdating = False


Dim dia(99), d As Integer, A(99, 99) As Double

i = 0

For d = 10 To 40 Step 2


	If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10

	If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10

	i = i + 1

	dia(i) = d

10 Next d


For q = 2 To 12

	For i = 1 To 12

			A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2)


	Next i


Next q


A_min = 2 * [S4] / 100


For q = 2 To 12 Step 2

	For i = 1 To 12

		For qq = 2 To 12 Step 2

			For ii = 1 To 12

				If ii = i Then GoTo 20

				If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20

			    If Abs(i - ii) > 2 Then GoTo 20' هذا هو السطر المضاف

				If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20

				If (A(q, i) + A(qq, ii)) < A_min Then

					A_min = A(q, i) + A(qq, ii)

					Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min

					q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii)

				End If

20		  Next ii


		Next qq

	Next i


Next q



For q = 2 To 12 Step 2

	For i = 1 To 12

		If A(q, i) < [S4] / 100 Then GoTo 30

		If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30

		If A(q, i) < A_min Then

			A_min = A(q, i) + A(qq, ii)

			Chosn = q & "f" & dia(i) & " = " & A_min

			q1 = q: d1 = dia(i): q2 = 0: d2 = 0

		End If

30  Next i

Next q

[S6] = Chosn


[E5:P16].Interior.ColorIndex = xlNone


cc1 = WorksheetFunction.Match(q1, [E4:P4], 0)

rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0)

Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3


If q2 = 0 Then GoTo 55

	cc2 = WorksheetFunction.Match(q2, [E4:P4], 0)

	rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0)

	Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3


55

Application.ScreenUpdating = True


End Sub

أبو أريج · ديسمبر 10, 2011

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

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

* للمساحة مثلا 12.30 cm² كانت النتيجة(2f28 = 12,32) أي 2 قضبان ذات قطر 28 مم ؟ و السؤال هل يمكن تحديد أدنى عدد هو 4 و ألا يزيد مثلا عن 8 أو عشرة (4-6-8-10)

* أدنى قطر للتسليح هو 12mm : لقد استبدلت في الكود ما يلي For d = 10 To 40 Step 2 و جعلته For d = 12 To 40 Step 2 هل هذا كافي؟

سامحني إن أثقلت عليك

**طارق محمود** · ديسمبر 11, 2011

السلام عليكم

الكود التالي بعد التعديلات

يقوم بعمل حد أدني للإختيار 4 قضبان وحد أعلي للإختيار 12 قضيب

وكذلك الأقطار تبدأ من 12

تفضل الكود

Private Sub Worksheet_Calculate()

Application.ScreenUpdating = False


Dim dia(99), d As Integer, A(99, 99) As Double

i = 0

For d = 12 To 40 Step 2


    If d = 26 Or d = 34 Or d = 36 Or d = 38 Then GoTo 10

    If d = 24 Then i = i + 1: dia(i) = 25: GoTo 10

    i = i + 1

    dia(i) = d

10 Next d


For q = 1 To 12

    For i = 1 To 11

		    A(q, i) = Round(q * dia(i) ^ 2 / 400 * WorksheetFunction.Pi, 2)

    Next i


Next q


A_min = 2 * [S4] / 100

For q = 2 To 12 Step 2

    For i = 1 To 11

	    For qq = 2 To 12 Step 2

		    For ii = 1 To 11

			    If ii = i Then GoTo 20

			    If (A(q, i) + A(qq, ii)) < [S4] / 100 Then GoTo 20

			    If Abs(i - ii) > 2 Then GoTo 20

			    If (A(q, i) + A(qq, ii)) > 1.5 * [S4] / 100 Then GoTo 20

			    If (A(q, i) + A(qq, ii)) < A_min And (q + qq) > 3 And (q + qq) < 12 Then

				    A_min = A(q, i) + A(qq, ii)

				    Chosn = q & "f" & dia(i) & " + " & qq & "f" & dia(ii) & " = " & A_min

				    q1 = q: d1 = dia(i): q2 = qq: d2 = dia(ii)

			    End If

20		  Next ii


	    Next qq

    Next i


Next q



For q = 2 To 12 Step 2

    For i = 1 To 11

	    If A(q, i) < [S4] / 100 Then GoTo 30

	    If A(q, i) > 1.5 * [S4] / 100 Then GoTo 30

	    If A(q, i) < A_min And q > 3 And q < 12 Then

		    A_min = A(q, i) + A(qq, ii)

		    Chosn = q & "f" & dia(i) & " = " & A_min

		    q1 = q: d1 = dia(i): q2 = 0: d2 = 0

	    End If

30  Next i

Next q

[S6] = Chosn


[E5:P16].Interior.ColorIndex = xlNone


cc1 = WorksheetFunction.Match(q1, [E4:P4], 0)

rr1 = WorksheetFunction.Match(d1, [Q5:Q16], 0)

Cells(rr1 + 4, cc1 + 4).Interior.ColorIndex = 3


If q2 = 0 Then GoTo 55

    cc2 = WorksheetFunction.Match(q2, [E4:P4], 0)

    rr2 = WorksheetFunction.Match(d2, [Q5:Q16], 0)

    Cells(rr2 + 4, cc2 + 4).Interior.ColorIndex = 3


55

Application.ScreenUpdating = True


End Sub

أبو أريج · ديسمبر 11, 2011

أخي العزيز

جزاك الله ألف خير : إنه كامل إن شاء الله

بارك الله فيك

تسجيل الدخول

(تمت الإجابة) كيف أجعل البرنامج يختار أحسن نتيجة من الجدول

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

أبو أريج

أبو أريج

طارق محمود

أبو أريج

طارق محمود

abouelhassan

أبو أريج

أبو أريج

طارق محمود

أبو أريج

طارق محمود

أبو أريج

طارق محمود

طارق محمود

أبو أريج

طارق محمود

أبو أريج

طارق محمود

أبو أريج

طارق محمود

أبو أريج

طارق محمود

أبو أريج

Join the conversation

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

تصفح الموقع

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

Support

Important Information