دالة if عن طريق الكود بدون استخدام for و next

[skyblue]

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

اخواني الاعضاء الافاضل برجاء المساعدة في الحل في الملف المرفق لانني اريد ان اضيف هذا الكود الى برنامج لدي .

ولكن بشرط ان يتم التسجيل على البيانات القديمة عند اي تحديث في الارصدة في الورقة1

تحياتي

Book1.rar

تم تعديل يونيو 15, 2011 بواسطه skyblue

[طارق محمود]

السلام عليكم

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

Private Sub Worksheet_Change(ByVal Target As Range)

t = Target.Value

If t = "" Then Exit Sub

a = Target.Address


If a = "$C$5" Then Sheets(2).[H7] = t

If a = "$D$5" Then Sheets(2).[I7] = t

If a = "$E$9" Then Sheets(2).[J8] = t

If a = "$F$9" Then Sheets(2).[K9] = t

End Sub

ملحوظة

أري أنه قد يكون اختلط الأمر عليك

اذا اكانت الخلية e9 في الورقة 1 لاتحتوي على فراغ يتم نقل المبلغ الى ورقة 2 في الخلية j8

اذا اكانت الخلية f9 في الورقة 1 لاتحتوي على فراغ يتم نقل المبلغ الى ورقة 2 في الخلية k9

الصحيح J13 ، K13

[طارق محمود]

مرفق الملف وبه الكود الصحيح من وجهه نظري

يمكنك تغيير السطرين الآخريين كما تحب

Intersect.rar

[skyblue]

مشكور استاذ طارق على الحل الرائع .

حفظك الله ورعاك

تحياتي لك

[skyblue]

الاستاذ طارق الموقر

بعد استخدام الكود اتضح لي الاتي :

الكود ينقل الارقام من ورقة 1 الى ورقة2 ععندما يتم تسجيل المبلغ مبشرة في الخلية .

اما اذا كانت الخلية تحتوي على معادلة فان الكود يتعطل .

مرفق ملف بذلك

Intersect.rar

[skyblue]

up

[skyblue]

up

[طارق محمود]

السلام عليكم

أخي العزيز

إستبدل الكود التالي بدلا عن الأول

Private Sub Worksheet_Change(ByVal Target As Range)


If [C5] <> Sheets(2).[H7] And [C5] <> "" Then Sheets(2).[H7] = [C5]

If [D5] <> Sheets(2).[I7] And [D5] <> "" Then Sheets(2).[I7] = [D5]

If [E9] <> Sheets(2).[J13] And [E9] <> "" Then Sheets(2).[J13] = [E9]

If [F9] <> Sheets(2).[K13] And [F9] <> "" Then Sheets(2).[K13] = [F9]


End Sub

وإذا كنت لاتريد الترحيل إن كانت نتيجة المعادلة صفر وليس "" فاستخدم هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)


If [C5] <> Sheets(2).[H7] And [C5] <> 0 Then Sheets(2).[H7] = [C5]

If [D5] <> Sheets(2).[I7] And [D5] <> 0 Then Sheets(2).[I7] = [D5]

If [E9] <> Sheets(2).[J13] And [E9] <> 0 Then Sheets(2).[J13] = [E9]

If [F9] <> Sheets(2).[K13] And [F9] <> 0 Then Sheets(2).[K13] = [F9]


End Sub

[skyblue]

نعم هذا هو المطلوب وزيادة يامهندس طارق

وايضا كود الترحيل اذا كانت الخلية صفر ايضا رائع .

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

ادعوا الله لك بالتوفيق والمغفرة .

تحياتي لك