كيف اطرح واجمع من خليه الي جدول

[atob]

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

اخواني الاعزاء اتمنى منكم مساعدتي في طلبي

وهو ان لدي جدول به اسماء وامام كل اسم عدد معين

ولدي قائمتين منسدله واما كل واحده خليه اضع فيها رقم

القائمه المنسدله الاولى عند اختيار اسم منها تقوم بأضافه العدد المقابل لها الي الاسم المختار في الجدول

والقائمه المنسدله الثانيه عند اختيار اسم منها تقوم بطرح الرقم المقابل لها من الاسم المختار في الجدول

واخيرا اشكر لكم تعاونكم معي ولا تحرموني من ردودكم فالله لا يحرمكم الاجر

طرح وجمع من جدول.rar

[عبدالله باقشير]

وعليكم السلام

'  للخصم

Sub kh_SUM1()

Dim Cel As Range

For Each Cel In Range("D12:D26")

    If CStr(Cel) = CStr(Range("D4")) Then

        Cel.Offset(0, 1).Value = Val(Cel.Offset(0, 1)) - Val(Range("E4"))

    End If

Next

End Sub


'  للجمع

Sub kh_SUM2()

Dim Cel As Range

For Each Cel In Range("D12:D26")

    If CStr(Cel) = CStr(Range("D8")) Then

        Cel.Offset(0, 1).Value = Val(Cel.Offset(0, 1)) + Val(Range("E8"))

    End If

Next

End Sub

[atob]

اخي عبدالله ما قصرت وكان حلك هو المطلوب فالله لا يحرمك الاجر

ولكن لدي طلب اخير وهو كيف اعدل في الكود السابق اذا اردت الطرح والجمع مرتبطا بتوافق قيم قائمتين منسدلتين

وهذا هو الكود الذي حاولت التعديل عليه ولكني لم اوفق

' ááÎÕã

Sub kh_SUM1()

Dim Cel As Range

Dim Cel2 As Range

For Each Cel In Range("D12:D26")

For Each Cel2 In Range("e12:e26")

If CStr(Cel) = CStr(Range("D4")) Then

If CStr(Cel2) = CStr(Range("e4")) Then

Cel.Offset(0, 2).Value = Val(Cel.Offset(0, 2)) - Val(Range("f4"))

End If

End If

Next

Next

End Sub

والملف المرفق يوضح اكثر

طرح وجمع من جدول1.rar

تم تعديل أكتوبر 10, 2012 بواسطه atob

[atob]

للرفع لحاجتي الي الحل

[جمال عبد السميع]

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

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

فهذا حل بالمعادلات:

طرح وجمع من جدول.rar

[عبدالله باقشير]

للرفع لحاجتي الي الحل

'  للخصم

Sub kh_SUM1()

Dim R As Long

For R = 12 To 26

    If CStr(Cells(R, "D")) = CStr(Range("D4")) And CStr(Cells(R, "E")) = CStr(Range("E4")) Then

        Cells(R, "F").Value = Val(Cells(R, "F")) - Val(Range("F4"))

    End If

Next

End Sub


'  للجمع

Sub kh_SUM2()

Dim R As Long

For R = 12 To 26

    If CStr(Cells(R, "D")) = CStr(Range("D8")) And CStr(Cells(R, "E")) = CStr(Range("E8")) Then

        Cells(R, "F").Value = Val(Cells(R, "F")) + Val(Range("F8"))

    End If

Next

End Sub

[عبدالله باقشير]

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

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

فهذا حل بالمعادلات:

اكرمك الله اخي الحبيب محمد

وجزاك خيرا وبارك فيك

وحفظك من كل مكروه

تقبل تحياتي وشكري

[الشهابي]

أستاذي القدير / عبد الله باقشير

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

وقمت بتطبقه وهو يؤدي المطلوب إن شاء الله

لو في خطأ في التعديل ممكن تتفضل مشكوراً بتوضيحه

وجزاكم الله خير

[/b]

[b]'  للخصم

Sub kh_SUM1()

Dim Cel As Range

For Each Cel In Range("D12:D26")

	    If CStr(Cel) = CStr(Range("D4")) And Cel.Offset(0, 1).Value = Range("e4") Then

					    Cel.Offset(0, 2).Value = Val(Cel.Offset(0, 2)) - Val(Range("f4"))


	    End If

	   Next

End Sub[/b]

[b]'  للجمع

Sub kh_SUM2()

Dim Cel As Range

For Each Cel In Range("D12:D26")

	    If CStr(Cel) = CStr(Range("D8")) And Cel.Offset(0, 1).Value = Range("e8") Then

			    Cel.Offset(0, 2).Value = Val(Cel.Offset(0, 2)) + Val(Range("f8"))

	    End If

Next

End Sub[/b]

[b]

[عبدالله باقشير]

اخي الشهابي

احسنت بارك الله فيك

[atob]

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